GnuCOBOL  2.0
A free COBOL compiler
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
 
struct  cb_func_prototype
 

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_SWITCH_16   16
 
#define CB_SWITCH_17   17
 
#define CB_SWITCH_18   18
 
#define CB_SWITCH_19   19
 
#define CB_SWITCH_20   20
 
#define CB_SWITCH_21   21
 
#define CB_SWITCH_22   22
 
#define CB_SWITCH_23   23
 
#define CB_SWITCH_24   24
 
#define CB_SWITCH_25   25
 
#define CB_SWITCH_26   26
 
#define CB_SWITCH_27   27
 
#define CB_SWITCH_28   28
 
#define CB_SWITCH_29   29
 
#define CB_SWITCH_30   30
 
#define CB_SWITCH_31   31
 
#define CB_SWITCH_32   32
 
#define CB_SWITCH_33   33
 
#define CB_SWITCH_34   34
 
#define CB_SWITCH_35   35
 
#define CB_SWITCH_36   36
 
#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_PROGRAM(x)   (CB_TREE_CAST (CB_TAG_PROGRAM, struct cb_program, x))
 
#define CB_FUNC_PROTOTYPE(x)   (CB_TREE_CAST (CB_TAG_FUNC_PROTOTYPE, struct cb_func_prototype, x))
 
#define CB_FUNC_PROTOTYPE_P(x)   (CB_TREE_TAG (x) == CB_TAG_FUNC_PROTOTYPE)
 
#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_FUNCALL_10(f, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
 
#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_commoncb_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_PROGRAM, CB_TAG_FUNC_PROTOTYPE
}
 
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
}
 
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
}
 
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
}
 
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
}
 
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
}
 
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
}
 
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
}
 
enum  cb_perform_type {
  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_picturecb_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_fieldcb_field_add (struct cb_field *, struct cb_field *)
 
struct cb_fieldcb_field_founder (const struct cb_field *)
 
struct cb_fieldcb_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_filebuild_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, 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_func_prototype (const cb_tree, const cb_tree)
 
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_statementcb_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_reportbuild_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_tablelookup_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_literalbuild_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_reservedlookup_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_fieldcb_resolve_redefines (struct cb_field *, cb_tree)
 
void cb_validate_field (struct cb_field *)
 
void cb_validate_88_item (struct cb_field *)
 
struct cb_fieldcb_validate_78_item (struct cb_field *, const cob_u32_t)
 
struct cb_fieldcb_get_real_field (void)
 
void cb_clear_real_field (void)
 
struct cb_programcb_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_omitted (cb_tree, struct cb_attr_struct *)
 
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_set_last_exception_to_off (void)
 
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_fieldcheck_level_78 (const char *)
 
struct cb_programcb_find_defined_program_by_name (const char *)
 
struct cb_programcb_find_defined_program_by_id (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 [16]
 
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 = CB_BUILD_CHAIN (x, y)

Definition at line 1854 of file tree.h.

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

#define CB_AFTER   cb_int1

Definition at line 26 of file tree.h.

Referenced by output_perform_until(), and yyparse().

#define CB_ALPHABET_ASCII   1
#define CB_ALPHABET_CUSTOM   3
#define CB_ALPHABET_EBCDIC   2
#define CB_ALPHABET_NATIVE   0

Definition at line 107 of file tree.h.

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

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

Definition at line 1068 of file tree.h.

Referenced by output_stmt().

#define CB_ALTER_P (   x)    (CB_TREE_TAG (x) == CB_TAG_ALTER)

Definition at line 1069 of file tree.h.

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

Definition at line 973 of file tree.h.

Referenced by output_stmt().

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

Definition at line 974 of file tree.h.

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

Definition at line 1842 of file tree.h.

Referenced by cb_emit_allocate(), and cb_emit_free().

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

Definition at line 1844 of file tree.h.

Referenced by cb_build_ppointer().

#define CB_BUILD_CHAIN (   x,
 
)    cb_build_list (NULL, x, y)
#define CB_BUILD_FUNCALL_0 (   f)
Value:
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1795 of file tree.h.

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_10 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6,
  a7,
  a8,
  a9,
  a10 
)
Value:
cb_build_funcall (f, 10, a1, a2, a3, a4, a5, a6, a7, a8, \
a9, a10, NULL)
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1835 of file tree.h.

Referenced by cb_emit_accept(), and cb_gen_field_accept().

#define CB_BUILD_FUNCALL_2 (   f,
  a1,
  a2 
)
#define CB_BUILD_FUNCALL_3 (   f,
  a1,
  a2,
  a3 
)
Value:
cb_build_funcall (f, 3, a1, a2, a3, NULL, NULL, NULL, \
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1807 of file tree.h.

Referenced by cb_build_add(), cb_build_cond(), cb_build_div(), cb_build_identifier(), 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(), decimal_assign(), and emit_screen_display().

#define CB_BUILD_FUNCALL_4 (   f,
  a1,
  a2,
  a3,
  a4 
)
Value:
cb_build_funcall (f, 4, a1, a2, a3, a4, NULL, \
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1811 of file tree.h.

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_5 (   f,
  a1,
  a2,
  a3,
  a4,
  a5 
)
Value:
cb_build_funcall (f, 5, a1, a2, a3, a4, a5, \
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1815 of file tree.h.

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

#define CB_BUILD_FUNCALL_6 (   f,
  a1,
  a2,
  a3,
  a4,
  a5,
  a6 
)
Value:
cb_build_funcall (f, 6, a1, a2, a3, a4, a5, a6, \
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1819 of file tree.h.

#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, \
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1823 of file tree.h.

#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, \
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1827 of file tree.h.

Referenced by emit_field_display().

#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, NULL)
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_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, const cb_tree)
Definition: tree.c:2916

Definition at line 1831 of file tree.h.

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

Definition at line 1853 of file tree.h.

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

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

Definition at line 1846 of file tree.h.

Referenced by cb_expr_shift().

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

Definition at line 1849 of file tree.h.

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

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

Definition at line 1047 of file tree.h.

Referenced by output_stmt().

#define CB_CALL_BY_CONTENT   2

Definition at line 45 of file tree.h.

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

#define CB_CALL_BY_REFERENCE   1

Definition at line 44 of file tree.h.

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

#define CB_CALL_BY_VALUE   3

Definition at line 46 of file tree.h.

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

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

Definition at line 1048 of file tree.h.

#define CB_CANCEL (   x)    (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x))

Definition at line 1057 of file tree.h.

Referenced by output_stmt().

#define CB_CANCEL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_CANCEL)

Definition at line 1058 of file tree.h.

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

Definition at line 963 of file tree.h.

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

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

Definition at line 1194 of file tree.h.

Referenced by ambiguous_error(), begin_scope_of_program_name(), 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_find_defined_program_by_id(), cb_find_defined_program_by_name(), 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(), get_last_elt(), 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(), yylex(), and yyparse().

#define CB_CHAIN_PAIR (   x,
  y,
 
)    x = cb_pair_add (x, y, z)

Definition at line 1855 of file tree.h.

Referenced by yyparse().

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

Definition at line 562 of file tree.h.

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

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

Definition at line 563 of file tree.h.

Referenced by yyparse().

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

Definition at line 476 of file tree.h.

Referenced by output_integer(), output_long_integer(), output_param(), 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))

Definition at line 1164 of file tree.h.

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

Definition at line 1165 of file tree.h.

#define CB_CONV_CALLEE_STACK   (1 << 1)

Definition at line 130 of file tree.h.

#define CB_CONV_L_TO_R   (1 << 0)

Definition at line 129 of file tree.h.

#define CB_CONV_NO_RET_UPD   (1 << 2)

Definition at line 131 of file tree.h.

Referenced by output_call(), and yyparse().

#define CB_CONV_OPT_LINK   (1 << 4)

Definition at line 133 of file tree.h.

#define CB_CONV_STATIC_LINK   (1 << 3)

Definition at line 132 of file tree.h.

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

#define CB_CONV_STDCALL   (1 << 6)

Definition at line 135 of file tree.h.

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

#define CB_CONV_THUNK_16   (1 << 5)

Definition at line 134 of file tree.h.

#define CB_DEBUG (   x)    (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x))

Definition at line 501 of file tree.h.

Referenced by output_stmt().

#define CB_DEBUG_CALL (   x)    (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x))

Definition at line 511 of file tree.h.

Referenced by output_stmt().

#define CB_DEBUG_CALL_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL)

Definition at line 512 of file tree.h.

#define CB_DEBUG_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DEBUG)

Definition at line 502 of file tree.h.

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

Definition at line 613 of file tree.h.

Referenced by output_param().

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

Definition at line 614 of file tree.h.

#define CB_DEVICE_CONSOLE   3
#define CB_DEVICE_SYSERR   2

Definition at line 155 of file tree.h.

Referenced by cb_build_display_mnemonic(), and cb_build_display_name().

#define CB_DEVICE_SYSIN   0

Definition at line 153 of file tree.h.

Referenced by cb_emit_accept_mnemonic(), and cb_emit_accept_name().

#define CB_DEVICE_SYSOUT   1

Definition at line 154 of file tree.h.

Referenced by cb_build_display_mnemonic(), and cb_build_display_name().

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

Definition at line 488 of file tree.h.

Referenced by cb_build_direct(), and output_stmt().

#define CB_DIRECT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_DIRECT)

Definition at line 489 of file tree.h.

#define CB_FEATURE_C01   2

Definition at line 198 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C02   3

Definition at line 199 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C03   4

Definition at line 200 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C04   5

Definition at line 201 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C05   6

Definition at line 202 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C06   7

Definition at line 203 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C07   8

Definition at line 204 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C08   9

Definition at line 205 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C09   10

Definition at line 206 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C10   11

Definition at line 207 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C11   12

Definition at line 208 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_C12   13

Definition at line 209 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FEATURE_CONVENTION   1

Definition at line 197 of file tree.h.

Referenced by yyparse().

#define CB_FEATURE_FORMFEED   0

Definition at line 196 of file tree.h.

Referenced by cb_build_write_advancing_mnemonic().

#define CB_FIELD_ADD (   x,
 
)    x = cb_field_add (x, y)
#define CB_FILE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_FILE)
#define CB_FUNC_PROTOTYPE (   x)    (CB_TREE_CAST (CB_TAG_FUNC_PROTOTYPE, struct cb_func_prototype, x))

Definition at line 1339 of file tree.h.

Referenced by check_for_duplicate_prototype(), output_param(), and yylex().

#define CB_FUNC_PROTOTYPE_P (   x)    (CB_TREE_TAG (x) == CB_TAG_FUNC_PROTOTYPE)

Definition at line 1340 of file tree.h.

Referenced by check_for_duplicate_prototype().

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

Definition at line 952 of file tree.h.

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

Definition at line 1079 of file tree.h.

Referenced by output_stmt().

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

Definition at line 1080 of file tree.h.

Referenced by build_evaluate(), and cb_check_needs_break().

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

Definition at line 1092 of file tree.h.

Referenced by output_search(), and output_stmt().

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

Definition at line 1093 of file tree.h.

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

Definition at line 1017 of file tree.h.

Referenced by output_stmt().

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

Definition at line 1018 of file tree.h.

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

Definition at line 523 of file tree.h.

Referenced by cb_build_const_length(), cb_emit_call(), and yyparse().

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

Definition at line 1002 of file tree.h.

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)

Definition at line 446 of file tree.h.

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

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

Definition at line 802 of file tree.h.

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

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

Definition at line 1189 of file tree.h.

Referenced by end_scope_of_program_name().

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

Definition at line 1190 of file tree.h.

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

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

Definition at line 574 of file tree.h.

Referenced by cb_name_1(), and output_param().

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

Definition at line 575 of file tree.h.

Referenced by cb_validate_program_environment(), and output_param().

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

Definition at line 1119 of file tree.h.

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

Definition at line 1116 of file tree.h.

Referenced by output_perform(), and output_perform_until().

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

Definition at line 632 of file tree.h.

#define CB_PREFIX_ATTR   "a_" /* Field attribute (cob_field_attr) */

Definition at line 30 of file tree.h.

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

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

Definition at line 32 of file tree.h.

Referenced by codegen(), and output_param().

#define CB_PREFIX_DECIMAL   "d_" /* Decimal number (cob_decimal) */

Definition at line 33 of file tree.h.

#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 */

Definition at line 38 of file tree.h.

Referenced by output_alphabet_name_definition(), and output_param().

#define CB_PREFIX_STRING   "st_" /* String */
#define CB_PROGRAM (   x)    (CB_TREE_CAST (CB_TAG_PROGRAM, struct cb_program, x))
#define CB_PROGRAM_TYPE   0
#define CB_PURPOSE_INT (   x)    (CB_INTEGER (CB_PURPOSE (x))->val)
#define CB_REPORT (   x)    (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x))

Definition at line 1228 of file tree.h.

Referenced by cb_validate_program_data(), and yyparse().

#define CB_REPORT_P (   x)    (CB_TREE_TAG (x) == CB_TAG_REPORT)

Definition at line 1229 of file tree.h.

Referenced by yyparse().

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

Definition at line 1031 of file tree.h.

Referenced by output_stmt().

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

Definition at line 1032 of file tree.h.

#define CB_SET_ATTR (   x)    (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x))

Definition at line 1176 of file tree.h.

Referenced by output_stmt().

#define CB_SET_ATTR_P (   x)    (CB_TREE_TAG (x) == CB_TAG_SET_ATTR)

Definition at line 1177 of file tree.h.

#define CB_SIZE_1   1

Definition at line 49 of file tree.h.

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

#define CB_SIZE_2   2

Definition at line 50 of file tree.h.

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

#define CB_SIZE_4   3

Definition at line 51 of file tree.h.

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

#define CB_SIZE_8   4

Definition at line 52 of file tree.h.

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

#define CB_SIZE_AUTO   0

Definition at line 48 of file tree.h.

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

#define CB_SIZE_UNSIGNED   8

Definition at line 53 of file tree.h.

Referenced by output_entry_function(), and yyparse().

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

Definition at line 1195 of file tree.h.

Referenced by output_entry_function(), and yyparse().

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

Definition at line 1199 of file tree.h.

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)

Definition at line 1200 of file tree.h.

Referenced by cb_emit_call(), and output_call_by_value_args().

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

Definition at line 1155 of file tree.h.

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

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

Definition at line 1156 of file tree.h.

Referenced by build_evaluate(), and cb_check_needs_break().

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

Definition at line 533 of file tree.h.

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

Definition at line 534 of file tree.h.

#define CB_SWITCH_0   0

Definition at line 158 of file tree.h.

#define CB_SWITCH_1   1

Definition at line 159 of file tree.h.

#define CB_SWITCH_10   10

Definition at line 168 of file tree.h.

#define CB_SWITCH_11   11

Definition at line 169 of file tree.h.

#define CB_SWITCH_12   12

Definition at line 170 of file tree.h.

#define CB_SWITCH_13   13

Definition at line 171 of file tree.h.

#define CB_SWITCH_14   14

Definition at line 172 of file tree.h.

#define CB_SWITCH_15   15

Definition at line 173 of file tree.h.

#define CB_SWITCH_16   16

Definition at line 174 of file tree.h.

#define CB_SWITCH_17   17

Definition at line 175 of file tree.h.

#define CB_SWITCH_18   18

Definition at line 176 of file tree.h.

#define CB_SWITCH_19   19

Definition at line 177 of file tree.h.

#define CB_SWITCH_2   2

Definition at line 160 of file tree.h.

#define CB_SWITCH_20   20

Definition at line 178 of file tree.h.

#define CB_SWITCH_21   21

Definition at line 179 of file tree.h.

#define CB_SWITCH_22   22

Definition at line 180 of file tree.h.

#define CB_SWITCH_23   23

Definition at line 181 of file tree.h.

#define CB_SWITCH_24   24

Definition at line 182 of file tree.h.

#define CB_SWITCH_25   25

Definition at line 183 of file tree.h.

#define CB_SWITCH_26   26

Definition at line 184 of file tree.h.

#define CB_SWITCH_27   27

Definition at line 185 of file tree.h.

#define CB_SWITCH_28   28

Definition at line 186 of file tree.h.

#define CB_SWITCH_29   29

Definition at line 187 of file tree.h.

#define CB_SWITCH_3   3

Definition at line 161 of file tree.h.

#define CB_SWITCH_30   30

Definition at line 188 of file tree.h.

#define CB_SWITCH_31   31

Definition at line 189 of file tree.h.

#define CB_SWITCH_32   32

Definition at line 190 of file tree.h.

#define CB_SWITCH_33   33

Definition at line 191 of file tree.h.

#define CB_SWITCH_34   34

Definition at line 192 of file tree.h.

#define CB_SWITCH_35   35

Definition at line 193 of file tree.h.

#define CB_SWITCH_36   36

Definition at line 194 of file tree.h.

#define CB_SWITCH_4   4

Definition at line 162 of file tree.h.

#define CB_SWITCH_5   5

Definition at line 163 of file tree.h.

#define CB_SWITCH_6   6

Definition at line 164 of file tree.h.

#define CB_SWITCH_7   7

Definition at line 165 of file tree.h.

#define CB_SWITCH_8   8

Definition at line 166 of file tree.h.

#define CB_SWITCH_9   9

Definition at line 167 of file tree.h.

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

Definition at line 587 of file tree.h.

Referenced by build_nested_special(), and yylex().

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

Definition at line 440 of file tree.h.

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_func_prototype(), 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_initialize(), 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_prototype_seen(), 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(), set_up_program(), set_up_use_file(), terminator_error(), validate_field_1(), validate_field_value(), validate_inspect(), warning_destination(), and yyparse().

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

Definition at line 465 of file tree.h.

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

Definition at line 445 of file tree.h.

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

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

Definition at line 1193 of file tree.h.

Referenced by ambiguous_error(), begin_scope_of_program_name(), 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_find_defined_program_by_id(), cb_find_defined_program_by_name(), 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(), warn_cannot_get_utc(), yylex(), and yyparse().

#define CB_WORD_HASH_MASK   (CB_WORD_HASH_SIZE - 1U)

Definition at line 58 of file tree.h.

Referenced by hash().

#define CB_WORD_HASH_SIZE   (1U << 11)

Definition at line 57 of file tree.h.

Referenced by hash().

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

Definition at line 906 of file tree.h.

Referenced by cb_build_section_name(), cb_check_field_debug(), yylex(), and yyparse().

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

Definition at line 871 of file tree.h.

Referenced by cb_build_program().

#define COB_MAX_SUBSCRIPTS   16

Definition at line 28 of file tree.h.

Typedef Documentation

typedef struct cb_tree_common* cb_tree

Definition at line 438 of file tree.h.

Enumeration Type Documentation

Enumerator
CB_CAST_INTEGER 
CB_CAST_LONG_INT 
CB_CAST_ADDRESS 
CB_CAST_ADDR_OF_ADDR 
CB_CAST_LENGTH 
CB_CAST_PROGRAM_POINTER 

Definition at line 290 of file tree.h.

290  {
291  CB_CAST_INTEGER = 0, /* 0 */
292  CB_CAST_LONG_INT, /* 1 */
293  CB_CAST_ADDRESS, /* 2 */
294  CB_CAST_ADDR_OF_ADDR, /* 3 */
295  CB_CAST_LENGTH, /* 4 */
297 };
Enumerator
CB_CATEGORY_UNKNOWN 
CB_CATEGORY_ALPHABETIC 
CB_CATEGORY_ALPHANUMERIC 
CB_CATEGORY_ALPHANUMERIC_EDITED 
CB_CATEGORY_BOOLEAN 
CB_CATEGORY_INDEX 
CB_CATEGORY_NATIONAL 
CB_CATEGORY_NATIONAL_EDITED 
CB_CATEGORY_NUMERIC 
CB_CATEGORY_NUMERIC_EDITED 
CB_CATEGORY_OBJECT_REFERENCE 
CB_CATEGORY_DATA_POINTER 
CB_CATEGORY_PROGRAM_POINTER 

Definition at line 226 of file tree.h.

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

Definition at line 213 of file tree.h.

213  {
214  CB_CLASS_UNKNOWN = 0, /* 0 */
215  CB_CLASS_ALPHABETIC, /* 1 */
216  CB_CLASS_ALPHANUMERIC, /* 2 */
217  CB_CLASS_BOOLEAN, /* 3 */
218  CB_CLASS_INDEX, /* 4 */
219  CB_CLASS_NATIONAL, /* 5 */
220  CB_CLASS_NUMERIC, /* 6 */
221  CB_CLASS_OBJECT, /* 7 */
222  CB_CLASS_POINTER /* 8 */
223 };
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 

Definition at line 300 of file tree.h.

300  {
301  CB_INTR_ABS = 1,
302  CB_INTR_ACOS,
304  CB_INTR_ASIN,
305  CB_INTR_ATAN,
308  CB_INTR_CHAR,
312  CB_INTR_COS,
320  CB_INTR_E,
327  CB_INTR_EXP,
347  CB_INTR_LOG,
351  CB_INTR_MAX,
352  CB_INTR_MEAN,
355  CB_INTR_MIN,
356  CB_INTR_MOD,
372  CB_INTR_ORD,
375  CB_INTR_PI,
379  CB_INTR_REM,
383  CB_INTR_SIGN,
384  CB_INTR_SIN,
385  CB_INTR_SQRT,
391  CB_INTR_SUM,
392  CB_INTR_TAN,
399  CB_INTR_TRIM,
405 };
Enumerator
CB_PERFORM_EXIT 
CB_PERFORM_ONCE 
CB_PERFORM_TIMES 
CB_PERFORM_UNTIL 
CB_PERFORM_FOREVER 

Definition at line 408 of file tree.h.

enum cb_storage
Enumerator
CB_STORAGE_CONSTANT 
CB_STORAGE_FILE 
CB_STORAGE_WORKING 
CB_STORAGE_LOCAL 
CB_STORAGE_LINKAGE 
CB_STORAGE_SCREEN 
CB_STORAGE_REPORT 
CB_STORAGE_COMMUNICATION 

Definition at line 243 of file tree.h.

243  {
244  CB_STORAGE_CONSTANT = 0, /* Constants */
245  CB_STORAGE_FILE, /* FILE SECTION */
246  CB_STORAGE_WORKING, /* WORKING-STORAGE SECTION */
247  CB_STORAGE_LOCAL, /* LOCAL-STORAGE SECTION */
248  CB_STORAGE_LINKAGE, /* LINKAGE SECTION */
249  CB_STORAGE_SCREEN, /* SCREEN SECTION */
250  CB_STORAGE_REPORT, /* REPORT SECTION */
251  CB_STORAGE_COMMUNICATION /* COMMUNICATION SECTION */
252 };
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 

Definition at line 138 of file tree.h.

enum cb_tag
Enumerator
CB_TAG_CONST 
CB_TAG_INTEGER 
CB_TAG_STRING 
CB_TAG_ALPHABET_NAME 
CB_TAG_CLASS_NAME 
CB_TAG_LOCALE_NAME 
CB_TAG_SYSTEM_NAME 
CB_TAG_LITERAL 
CB_TAG_DECIMAL 
CB_TAG_FIELD 
CB_TAG_FILE 
CB_TAG_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_PROGRAM 
CB_TAG_FUNC_PROTOTYPE 

Definition at line 61 of file tree.h.

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  CB_TAG_PROGRAM, /* 36 Program */
103  CB_TAG_FUNC_PROTOTYPE /* 37 Function prototype */
104 };
Definition: tree.h:88
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 

Definition at line 255 of file tree.h.

255  {
256  CB_USAGE_BINARY = 0, /* 0 */
257  CB_USAGE_BIT, /* 1 */
258  CB_USAGE_COMP_5, /* 2 */
259  CB_USAGE_COMP_X, /* 3 */
260  CB_USAGE_DISPLAY, /* 4 */
261  CB_USAGE_FLOAT, /* 5 */
262  CB_USAGE_DOUBLE, /* 6 */
263  CB_USAGE_INDEX, /* 7 */
264  CB_USAGE_NATIONAL, /* 8 */
265  CB_USAGE_OBJECT, /* 9 */
266  CB_USAGE_PACKED, /* 10 */
267  CB_USAGE_POINTER, /* 11 */
268  CB_USAGE_PROGRAM, /* 12 */
269  CB_USAGE_LENGTH, /* 13 */
270  CB_USAGE_PROGRAM_POINTER, /* 14 */
271  CB_USAGE_UNSIGNED_CHAR, /* 15 */
272  CB_USAGE_SIGNED_CHAR, /* 16 */
273  CB_USAGE_UNSIGNED_SHORT, /* 17 */
274  CB_USAGE_SIGNED_SHORT, /* 18 */
275  CB_USAGE_UNSIGNED_INT, /* 19 */
276  CB_USAGE_SIGNED_INT, /* 20 */
277  CB_USAGE_UNSIGNED_LONG, /* 21 */
278  CB_USAGE_SIGNED_LONG, /* 22 */
279  CB_USAGE_COMP_6, /* 23 */
280  CB_USAGE_FP_DEC64, /* 24 */
281  CB_USAGE_FP_DEC128, /* 25 */
282  CB_USAGE_FP_BIN32, /* 26 */
283  CB_USAGE_FP_BIN64, /* 27 */
284  CB_USAGE_FP_BIN128, /* 28 */
285  CB_USAGE_LONG_DOUBLE /* 29 */
286 };

Function Documentation

void ambiguous_error ( cb_tree  )

Definition at line 341 of file error.c.

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, cb_field::parent, and cb_label::section.

Referenced by cb_ref().

342 {
343  struct cb_word *w;
344  struct cb_field *p;
345  struct cb_label *l2;
346  cb_tree l;
347  cb_tree y;
348 
349  w = CB_REFERENCE (x)->word;
350  if (w->error == 0) {
351  if (!errnamebuff) {
353  }
354  /* Display error the first time */
355  snprintf (errnamebuff, (size_t)COB_NORMAL_MAX, "'%s'", CB_NAME (x));
357  for (l = CB_REFERENCE (x)->chain; l; l = CB_REFERENCE (l)->chain) {
358  strcat (errnamebuff, " in '");
359  strcat (errnamebuff, CB_NAME (l));
360  strcat (errnamebuff, "'");
361  }
362  cb_error_x (x, _("%s ambiguous; need qualification"), errnamebuff);
363  w->error = 1;
364 
365  /* Display all fields with the same name */
366  for (l = w->items; l; l = CB_CHAIN (l)) {
367  y = CB_VALUE (l);
368  snprintf (errnamebuff, (size_t)COB_NORMAL_MAX,
369  "'%s' ", w->name);
371  switch (CB_TREE_TAG (y)) {
372  case CB_TAG_FIELD:
373  for (p = CB_FIELD (y)->parent; p; p = p->parent) {
374  strcat (errnamebuff, "in '");
375  strcat (errnamebuff, cb_name (CB_TREE(p)));
376  strcat (errnamebuff, "' ");
377  }
378  break;
379  case CB_TAG_LABEL:
380  l2 = CB_LABEL (y);
381  if (l2->section) {
382  strcat (errnamebuff, "in '");
383  strcat (errnamebuff,
384  (const char *)(l2->section->name));
385  strcat (errnamebuff, "' ");
386  }
387  break;
388  default:
389  break;
390  }
391  strcat (errnamebuff, _("defined here"));
392  cb_error_x (y, errnamebuff);
393  }
394  }
395 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_LABEL(x)
Definition: tree.h:801
void * cobc_main_malloc(const size_t size)
Definition: cobc.c:702
const char * name
Definition: tree.h:766
#define COB_NORMAL_BUFF
Definition: common.h:541
char * cb_name(cb_tree x)
Definition: tree.c:735
#define CB_VALUE(x)
Definition: tree.h:1193
const char * name
Definition: tree.h:865
struct cb_label * section
Definition: tree.h:768
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
#define CB_TREE_TAG(x)
Definition: tree.h:441
int error
Definition: tree.h:868
#define CB_NAME(x)
Definition: tree.h:904
#define CB_REFERENCE(x)
Definition: tree.h:901
#define COB_NORMAL_MAX
Definition: common.h:547
cb_tree items
Definition: tree.h:866
struct cb_field * parent
Definition: tree.h:651
static char * errnamebuff
Definition: error.c:34
Definition: tree.h:764
Definition: tree.h:863
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_file* build_file ( cb_tree  )

Definition at line 2344 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 722 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_report* build_report ( cb_tree  )

Definition at line 2324 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_add_78 ( struct cb_field )

Definition at line 4810 of file scanner.c.

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.

Referenced by cb_validate_78_item().

4811 {
4812  struct cb_level_78 *p78;
4813 
4814  /* Add a constant (78 level) item */
4815  p78 = cobc_malloc (sizeof(struct cb_level_78));
4816  p78->fld78 = f;
4817  p78->prog = current_program;
4818  p78->pic_replace = check_78_replace (CB_VALUE(f->values));
4819  if (p78->pic_replace) {
4820  p78->pic_len = (cob_u32_t)strlen (p78->pic_replace);
4821  }
4822  p78->name_len = (cob_u32_t)strlen (f->name);
4823  if (f->flag_is_global) {
4824  if (!globlev78ptr) {
4825  p78->last = p78;
4826  } else {
4827  p78->last = globlev78ptr->last;
4828  }
4829  p78->last->globnext = const78ptr;
4830  p78->next = globlev78ptr;
4831  p78->globnext = globlev78ptr;
4832  p78->chk_const = 1;
4833  globlev78ptr = p78;
4834  if (lev78ptr) {
4836  } else {
4838  }
4839  } else {
4840  if (!lev78ptr) {
4841  p78->last = p78;
4842  } else {
4843  p78->last = lev78ptr->last;
4844  }
4845  if (globlev78ptr) {
4846  p78->last->globnext = globlev78ptr;
4847  } else {
4848  p78->last->globnext = const78ptr;
4849  }
4850  p78->next = lev78ptr;
4851  p78->globnext = lev78ptr;
4852  lev78ptr = p78;
4853  top78ptr = lev78ptr;
4854  }
4855 }
#define cob_u32_t
Definition: common.h:31
static struct cb_level_78 * globlev78ptr
Definition: scanner.c:1439
struct cb_level_78 * last
Definition: scanner.c:1420
struct cb_level_78 * globnext
Definition: scanner.c:1419
struct cb_field * fld78
Definition: scanner.c:1421
#define CB_VALUE(x)
Definition: tree.h:1193
struct cb_level_78 * next
Definition: scanner.c:1418
static struct cb_level_78 * lev78ptr
Definition: scanner.c:1438
struct cb_program * prog
Definition: scanner.c:1422
cob_u32_t name_len
Definition: scanner.c:1424
static const char * check_78_replace(const cb_tree p)
Definition: scanner.c:4486
cob_u32_t pic_len
Definition: scanner.c:1425
static struct cb_level_78 * const78ptr
Definition: scanner.c:1437
struct cb_program * current_program
Definition: parser.c:168
const char * pic_replace
Definition: scanner.c:1423
void * cobc_malloc(const size_t size)
Definition: cobc.c:643
static struct cb_level_78 * top78ptr
Definition: scanner.c:1436
cob_u32_t chk_const
Definition: scanner.c:1427

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_add_common_prog ( struct cb_program )

Definition at line 1469 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_add ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 4015 of file typeck.c.

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, COB_POINTER_MANIP, cb_field::count, and optimize_defs.

Referenced by cb_build_perform_varying(), cb_emit_arithmetic(), cb_emit_set_up_down(), and yyparse().

4016 {
4017  cb_tree opt;
4018  struct cb_field *f;
4019 
4020 #ifdef COB_NON_ALIGNED
4021  if (CB_INDEX_P (v)) {
4022  return cb_build_move (cb_build_binary_op (v, '+', n), v);
4023  }
4024  if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
4026  return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", v, n, cb_int0);
4027  }
4028 #else
4029  if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
4030  return cb_build_move (cb_build_binary_op (v, '+', n), v);
4031  }
4032 #endif
4033 
4034  if (CB_REF_OR_FIELD_P (v)) {
4035  f = CB_FIELD_PTR (v);
4036  f->count++;
4037  }
4038  if (CB_REF_OR_FIELD_P (n)) {
4039  f = CB_FIELD_PTR (n);
4040  f->count++;
4041  }
4042  if (round_opt == cb_high) {
4043  /* Short circuit from tree.c for perform */
4044  if (cb_fits_int (n)) {
4045  return cb_build_optim_add (v, n);
4046  } else {
4047  return CB_BUILD_FUNCALL_3 ("cob_add", v, n, cb_int0);
4048  }
4049  }
4050  opt = build_store_option (v, round_opt);
4051  if (opt == cb_int0 && cb_fits_int (n)) {
4052  return cb_build_optim_add (v, n);
4053  }
4054  return CB_BUILD_FUNCALL_3 ("cob_add", v, n, opt);
4055 }
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_FIELD_PTR(x)
Definition: tree.h:745
#define CB_TREE_CLASS(x)
Definition: tree.h:442
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
static cb_tree cb_build_optim_add(cb_tree v, cb_tree n)
Definition: typeck.c:3876
#define CB_INDEX_P(x)
Definition: tree.h:750
Definition: tree.h:643
cb_tree cb_int0
Definition: tree.c:133
int count
Definition: tree.h:680
int cb_fits_int(const cb_tree x)
Definition: tree.c:914
cb_tree cb_high
Definition: tree.c:129
static cb_tree build_store_option(cb_tree x, cb_tree round_opt)
Definition: typeck.c:3193
cob_u32_t optimize_defs[COB_OPTIM_MAX]
Definition: cobc.c:182
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
cb_tree cb_build_binary_op(cb_tree x, const int op, cb_tree y)
Definition: tree.c:2827

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_address ( cb_tree  )

Definition at line 1357 of file typeck.c.

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.

Referenced by cb_build_identifier(), and yyparse().

1358 {
1359  cb_tree v;
1360  struct cb_reference *r;
1361  const char *name;
1362  int numsubs;
1363  int refsubs;
1364 
1365  if (x == cb_error_node) {
1366  return cb_error_node;
1367  }
1368  if (!CB_REFERENCE_P (x)) {
1369  return CB_BUILD_CAST_ADDRESS (x);
1370  }
1371 
1372  r = CB_REFERENCE (x);
1373  name = r->word->name;
1374  v = cb_ref (x);
1375  if (v == cb_error_node) {
1376  return cb_error_node;
1377  }
1378 
1379  refsubs = cb_list_length (r->subs);
1380  if (CB_FIELD_P (v)) {
1381  numsubs = CB_FIELD (v)->indexes;
1382  if (refsubs > numsubs) {
1383  goto subserror;
1384  } else if (refsubs < numsubs) {
1385  if (!cb_relaxed_syntax_check) {
1386  goto subserror;
1387  } else {
1388  cb_warning_x (x,
1389  _("Subscripts missing for '%s' - Defaulting to 1"),
1390  name);
1391  for (; refsubs < numsubs; ++refsubs) {
1392  CB_ADD_TO_CHAIN (cb_one, r->subs);
1393  }
1394  }
1395  }
1396  } else {
1397  numsubs = 0;
1398  if (r->subs) {
1399  goto subserror;
1400  }
1401  if (r->offset) {
1402  cb_error_x (x, _("'%s' cannot be reference modified"), name);
1403  return cb_error_node;
1404  }
1405  }
1406 
1407  return CB_BUILD_CAST_ADDRESS (x);
1408 
1409 subserror:
1410  switch (numsubs) {
1411  case 0:
1412  cb_error_x (x, _("'%s' cannot be subscripted"), name);
1413  break;
1414  case 1:
1415  cb_error_x (x, _("'%s' requires 1 subscript"), name);
1416  break;
1417  default:
1418  cb_error_x (x, _("'%s' requires %d subscripts"),
1419  name, numsubs);
1420  break;
1421  }
1422  return cb_error_node;
1423 }
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
const char * name
Definition: tree.h:865
int cb_list_length(cb_tree l)
Definition: tree.c:1342
#define CB_FIELD_P(x)
Definition: tree.h:741
#define CB_BUILD_CAST_ADDRESS(x)
Definition: tree.h:1841
#define _(s)
Definition: cobcrun.c:59
cb_tree offset
Definition: tree.h:878
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_one
Definition: tree.c:126
cb_tree cb_error_node
Definition: tree.c:140
#define CB_ADD_TO_CHAIN(x, y)
Definition: tree.h:1854
cb_tree subs
Definition: tree.h:877
#define CB_FIELD(x)
Definition: tree.h:740
struct cb_word * word
Definition: tree.h:881

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_alphabet_name ( cb_tree  )

Definition at line 1605 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_alphanumeric_literal ( const void *  ,
const size_t   
)

Definition at line 1716 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_alter ( const cb_tree  ,
const cb_tree   
)

Definition at line 3101 of file tree.c.

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

Referenced by cb_emit_alter().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_any_intrinsic ( cb_tree  )

Definition at line 3295 of file tree.c.

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

Referenced by cb_build_length().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_assign ( const cb_tree  ,
const cb_tree   
)

Definition at line 3014 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_assignment_name ( struct cb_file ,
cb_tree   
)

Definition at line 1276 of file typeck.c.

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, cb_program::reference_list, and warningopt.

Referenced by yyparse().

1277 {
1278  const char *s;
1279  const char *p;
1280 
1281  if (name == cb_error_node) {
1282  return cb_error_node;
1283  }
1284  /* For special assignment */
1285  if (name == NULL) {
1286  return NULL;
1287  }
1288 
1289  switch (CB_TREE_TAG (name)) {
1290  case CB_TAG_LITERAL:
1291  return name;
1292 
1293  case CB_TAG_REFERENCE:
1294  s = CB_NAME (name);
1295  if (cb_assign_clause == CB_ASSIGN_MF) {
1296  if (cfile->flag_ext_assign) {
1297  p = strrchr (s, '-');
1298  if (p) {
1299  s = p + 1;
1300  }
1301  return cb_build_alphanumeric_literal (s, strlen (s));
1302  }
1305  return name;
1306  } else if (cb_assign_clause == CB_ASSIGN_IBM) {
1307  /* Check organization */
1308  if (strncmp (s, "S-", (size_t)2) == 0 ||
1309  strncmp (s, "AS-", (size_t)3) == 0) {
1310  goto org;
1311  }
1312  /* Skip the device label if exists */
1313  if ((p = strchr (s, '-')) != NULL) {
1314  s = p + 1;
1315  }
1316  /* Check organization again */
1317  if (strncmp (s, "S-", (size_t)2) == 0 ||
1318  strncmp (s, "AS-", (size_t)3) == 0) {
1319 org:
1320  /* Skip it for now */
1321  s = strchr (s, '-') + 1;
1322  }
1323  /* Convert the name into literal */
1324  if (warningopt) {
1325  cb_warning (_("ASSIGN interpreted as %s"), s);
1326  }
1327  return cb_build_alphanumeric_literal (s, strlen (s));
1328  }
1329  /* Fall through for CB_ASSIGN_COBOL2002 */
1330  /* To be looked at */
1331  default:
1332  return cb_error_node;
1333  }
1334 }
cb_tree reference_list
Definition: tree.h:1255
int warningopt
Definition: cobc.c:176
#define CB_ASSIGN_IBM
Definition: cobc.h:78
cb_tree cb_build_alphanumeric_literal(const void *data, const size_t size)
Definition: tree.c:1716
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_TREE_TAG(x)
Definition: tree.h:441
#define CB_NAME(x)
Definition: tree.h:904
cb_tree cb_error_node
Definition: tree.c:140
#define CB_ASSIGN_MF
Definition: cobc.h:77
struct cb_program * current_program
Definition: parser.c:168
void cb_warning(const char *,...) COB_A_FORMAT12
Definition: error.c:87
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_binary_list ( cb_tree  ,
const int   
)

Definition at line 2902 of file tree.c.

References cb_build_binary_op(), CB_CHAIN, and CB_VALUE.

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_binary_op ( cb_tree  ,
const int  ,
cb_tree   
)

Definition at line 2827 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_picture* cb_build_binary_picture ( const char *  ,
const cob_u32_t  ,
const cob_u32_t   
)

Definition at line 1783 of file tree.c.

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

Referenced by validate_field_1().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_call ( const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cob_u32_t  ,
const int   
)

Definition at line 3067 of file tree.c.

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

Referenced by cb_emit_call().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cancel ( const cb_tree  )

Definition at line 3088 of file tree.c.

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

Referenced by cb_emit_cancel().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cast ( const enum  cb_cast_type,
const cb_tree   
)

Definition at line 2947 of file tree.c.

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

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

Here is the call graph for this function:

cb_tree cb_build_cast_int ( const cb_tree  )

Definition at line 2964 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cast_llint ( const cb_tree  )

Definition at line 2975 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_class_name ( cb_tree  ,
cb_tree   
)

Definition at line 1622 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_comment ( const char *  )

Definition at line 1540 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cond ( cb_tree  )

Definition at line 3737 of file typeck.c.

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_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, cb_binary_op::x, and cb_binary_op::y.

Referenced by build_evaluate(), cb_build_search_all(), and yyparse().

3738 {
3739  struct cb_field *f;
3740  struct cb_binary_op *p;
3741  cb_tree d1;
3742  cb_tree d2;
3743  int size1;
3744  int size2;
3745 
3746  if (x == cb_error_node) {
3747  return cb_error_node;
3748  }
3749  switch (CB_TREE_TAG (x)) {
3750  case CB_TAG_CONST:
3751  if (x != cb_any && x != cb_true && x != cb_false) {
3753  _("Invalid expression"));
3754  return cb_error_node;
3755  }
3756  return x;
3757  case CB_TAG_FUNCALL:
3758  return x;
3759  case CB_TAG_REFERENCE:
3760  if (!CB_FIELD_P (cb_ref (x))) {
3761  return cb_build_cond (cb_ref (x));
3762  }
3763 
3764  f = CB_FIELD_PTR (x);
3765 
3766  /* Level 88 condition */
3767  if (f->level == 88) {
3768  /* Build an 88 condition at every occurrence */
3769  /* as it may be subscripted */
3770  return cb_build_cond (build_cond_88 (x));
3771  }
3772 
3773  break;
3774  case CB_TAG_BINARY_OP:
3775  p = CB_BINARY_OP (x);
3776  if (!p->x || p->x == cb_error_node) {
3777  return cb_error_node;
3778  }
3779  switch (p->op) {
3780  case '!':
3781  return CB_BUILD_NEGATION (cb_build_cond (p->x));
3782  case '&':
3783  case '|':
3784  if (!p->y || p->y == cb_error_node) {
3785  return cb_error_node;
3786  }
3787  return cb_build_binary_op (cb_build_cond (p->x), p->op, cb_build_cond (p->y));
3788  default:
3789  if (!p->y || p->y == cb_error_node) {
3790  return cb_error_node;
3791  }
3792  if (CB_INDEX_P (p->x) || CB_INDEX_P (p->y) ||
3793  CB_TREE_CLASS (p->x) == CB_CLASS_POINTER ||
3794  CB_TREE_CLASS (p->y) == CB_CLASS_POINTER) {
3795  x = cb_build_binary_op (p->x, '-', p->y);
3796  } else if (CB_BINARY_OP_P (p->x) ||
3797  CB_BINARY_OP_P (p->y)) {
3798  /* Decimal comparison */
3799  d1 = decimal_alloc ();
3800  d2 = decimal_alloc ();
3801 
3802  decimal_expand (d1, p->x);
3803  decimal_expand (d2, p->y);
3804  dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_cmp", d1, d2));
3805  decimal_free ();
3806  decimal_free ();
3808  decimal_stack = NULL;
3809  } else {
3810  /* DEBUG Bypass optimization for PERFORM */
3812  x = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y);
3813  break;
3814  }
3815  if (cb_chk_num_cond (p->x, p->y)) {
3816  size1 = cb_field_size (p->x);
3817  x = CB_BUILD_FUNCALL_3 ("memcmp",
3818  CB_BUILD_CAST_ADDRESS (p->x),
3819  CB_BUILD_CAST_ADDRESS (p->y),
3820  cb_int (size1));
3821  break;
3822  }
3823  if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC &&
3824  CB_TREE_CLASS (p->y) == CB_CLASS_NUMERIC &&
3825  cb_fits_long_long (p->y)) {
3826  x = cb_build_optim_cond (p);
3827  break;
3828  }
3829 
3830  /* Field comparison */
3831  if ((CB_REF_OR_FIELD_P (p->x)) &&
3834  cb_field_size (p->x) == 1 &&
3836  (p->y == cb_space || p->y == cb_low ||
3837  p->y == cb_high || p->y == cb_zero)) {
3838  x = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y);
3839  break;
3840  }
3841  if (cb_chk_alpha_cond (p->x) &&
3842  cb_chk_alpha_cond (p->y)) {
3843  size1 = cb_field_size (p->x);
3844  size2 = cb_field_size (p->y);
3845  } else {
3846  size1 = 0;
3847  size2 = 0;
3848  }
3849  if (size1 == 1 && size2 == 1) {
3850  x = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y);
3851  } else if (size1 != 0 && size1 == size2) {
3852  x = CB_BUILD_FUNCALL_3 ("memcmp",
3853  CB_BUILD_CAST_ADDRESS (p->x),
3854  CB_BUILD_CAST_ADDRESS (p->y),
3855  cb_int (size1));
3856  } else {
3857  if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC && p->y == cb_zero) {
3858  x = cb_build_optim_cond (p);
3859  } else {
3860  x = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y);
3861  }
3862  }
3863  }
3864  }
3865  return cb_build_binary_op (x, p->op, p->y);
3866  default:
3867  break;
3868  }
3869  cb_error_x (x, _("Invalid expression"));
3870  return cb_error_node;
3871 }
static cob_decimal d2
Definition: intrinsic.c:80
#define CB_TREE(x)
Definition: tree.h:440
static int cb_field_size(const cb_tree x)
Definition: typeck.c:790
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_true
Definition: tree.c:122
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static cb_tree decimal_stack
Definition: typeck.c:94
static int cb_chk_alpha_cond(cb_tree x)
Definition: typeck.c:3712
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
cb_tree cb_zero
Definition: tree.c:125
cob_decimal * d1
Definition: cobxref.c.l.h:21
static void decimal_expand(cb_tree d, cb_tree x)
Definition: typeck.c:3285
cb_tree cb_false
Definition: tree.c:123
#define dpush(x)
Definition: typeck.c:73
cb_tree cb_any
Definition: tree.c:121
int level
Definition: tree.h:673
int cb_fits_long_long(const cb_tree x)
Definition: tree.c:991
cb_tree cb_space
Definition: tree.c:127
unsigned int flag_debugging
Definition: tree.h:1320
#define CB_BUILD_NEGATION(x)
Definition: tree.h:1847
#define CB_TREE_CLASS(x)
Definition: tree.h:442
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
#define CB_BINARY_OP_P(x)
Definition: tree.h:937
#define CB_FIELD_P(x)
Definition: tree.h:741
#define CB_BUILD_CAST_ADDRESS(x)
Definition: tree.h:1841
#define CB_INDEX_P(x)
Definition: tree.h:750
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
static void decimal_free(void)
Definition: typeck.c:3251
static cb_tree decimal_alloc(void)
Definition: typeck.c:3229
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
int op
Definition: tree.h:932
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_TREE_TAG(x)
Definition: tree.h:441
static int cb_chk_num_cond(cb_tree x, cb_tree y)
Definition: typeck.c:3668
cb_tree alphabet_name_list
Definition: tree.h:1256
cb_tree cb_int(const int n)
Definition: tree.c:1488
static cb_tree build_cond_88(cb_tree x)
Definition: typeck.c:3519
cb_tree cb_error_node
Definition: tree.c:140
cb_tree y
Definition: tree.h:931
static cb_tree cb_build_optim_cond(struct cb_binary_op *p)
Definition: typeck.c:3558
struct cb_program * current_program
Definition: parser.c:168
cb_tree cb_high
Definition: tree.c:129
cb_tree x
Definition: tree.h:930
#define CB_BINARY_OP(x)
Definition: tree.h:936
cb_tree cb_build_cond(cb_tree x)
Definition: typeck.c:3737
cb_tree cb_list_reverse(cb_tree l)
Definition: tree.c:1327
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
struct cb_statement * current_statement
Definition: parser.c:169
cb_tree cb_build_binary_op(cb_tree x, const int op, cb_tree y)
Definition: tree.c:2827
cb_tree cb_low
Definition: tree.c:128

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_const_length ( cb_tree  )

Definition at line 1730 of file typeck.c.

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.

Referenced by yyparse().

1731 {
1732  struct cb_field *f;
1733  char buff[32];
1734 
1735  if (x == cb_error_node) {
1736  return cb_error_node;
1737  }
1738  if (CB_INTEGER_P (x)) {
1739  sprintf (buff, "%d", CB_INTEGER(x)->val);
1740  return cb_build_numeric_literal (0, buff, 0);
1741  }
1742  if (CB_REFERENCE_P (x)) {
1743  if (cb_ref (x) == cb_error_node) {
1744  return cb_error_node;
1745  }
1746  if (CB_REFERENCE (x)->offset) {
1747  cb_error (_("Reference modification not allowed here"));
1748  return cb_error_node;
1749  }
1750  }
1751 
1752  memset (buff, 0, sizeof (buff));
1753  f = CB_FIELD (cb_ref (x));
1754  if (f->flag_any_length) {
1755  cb_error (_("ANY LENGTH item not allowed here"));
1756  return cb_error_node;
1757  }
1758  if (f->level == 88) {
1759  cb_error (_("88 level item not allowed here"));
1760  return cb_error_node;
1761  }
1762  if (cb_field_variable_size (f)) {
1763  cb_error (_("Variable length item not allowed here"));
1764  return cb_error_node;
1765  }
1766  if (f->redefines) {
1768  if (f->rename_thru) {
1770  }
1771  cb_validate_field (f);
1772  sprintf (buff, "%d", f->size);
1773  } else {
1774  cb_validate_field (f);
1775  sprintf (buff, "%d", f->memory_size);
1776  }
1777  return cb_build_numeric_literal (0, buff, 0);
1778 }
#define CB_REFERENCE_P(x)
Definition: tree.h:902
#define CB_INTEGER(x)
Definition: tree.h:522
unsigned int flag_any_length
Definition: tree.h:712
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
struct cb_field * cb_field_variable_size(const struct cb_field *f)
Definition: tree.c:2239
int level
Definition: tree.h:673
cb_tree cb_build_numeric_literal(const int sign, const void *data, const int scale)
Definition: tree.c:1681
int offset
Definition: tree.h:675
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_REFERENCE(x)
Definition: tree.h:901
int size
Definition: tree.h:672
struct cb_field * rename_thru
Definition: tree.h:655
cb_tree cb_error_node
Definition: tree.c:140
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
int memory_size
Definition: tree.h:674
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338
struct cb_field * redefines
Definition: tree.h:654
#define CB_INTEGER_P(x)
Definition: tree.h:523
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_constant ( cb_tree  ,
cb_tree   
)

Definition at line 2189 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_continue ( void  )

Definition at line 3214 of file tree.c.

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

Referenced by cb_emit_continue().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_converting ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5954 of file typeck.c.

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

Referenced by yyparse().

5955 {
5956  validate_inspect (x, y, 2);
5957  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_converting", x, y));
5958 }
static void validate_inspect(cb_tree x, cb_tree y, const unsigned int replconv)
Definition: typeck.c:5714
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_debug ( const cb_tree  ,
const char *  ,
const cb_tree   
)

Definition at line 1566 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_debug_call ( struct cb_label )

Definition at line 1590 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_build_debug_item ( void  )

Definition at line 2243 of file typeck.c.

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.

Referenced by yyparse().

2244 {
2245  cb_tree l;
2246  cb_tree x;
2247  cb_tree assign;
2248 
2249  /* Set up DEBUG-ITEM */
2250  l = cb_build_reference ("DEBUG-ITEM");
2252  NULL, 1);
2253  CB_FIELD (assign)->values = CB_LIST_INIT (cb_space);
2254  cb_debug_item = l;
2255 
2256  l = cb_build_reference ("DEBUG-LINE");
2257  x = cb_build_field_tree (NULL, l, CB_FIELD(assign),
2258  CB_STORAGE_WORKING, NULL, 3);
2259  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("9(6)"));
2261  cb_debug_line = l;
2262 
2263  l = cb_build_filler ();
2264  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2265  CB_STORAGE_WORKING, NULL, 3);
2266  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2267  CB_FIELD (x)->flag_filler = 1;
2269 
2270  l = cb_build_reference ("DEBUG-NAME");
2271  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2272  CB_STORAGE_WORKING, NULL, 3);
2273  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(31)"));
2275  cb_debug_name = l;
2276 
2277  l = cb_build_filler ();
2278  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2279  CB_STORAGE_WORKING, NULL, 3);
2280  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2281  CB_FIELD (x)->flag_filler = 1;
2283 
2284  l = cb_build_reference ("DEBUG-SUB-1");
2285  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2286  CB_STORAGE_WORKING, NULL, 3);
2287  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
2288  CB_FIELD (x)->flag_sign_leading = 1;
2289  CB_FIELD (x)->flag_sign_separate = 1;
2291  cb_debug_sub_1 = l;
2292 
2293  l = cb_build_filler ();
2294  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2295  CB_STORAGE_WORKING, NULL, 3);
2296  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2297  CB_FIELD (x)->flag_filler = 1;
2299 
2300  l = cb_build_reference ("DEBUG-SUB-2");
2301  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2302  CB_STORAGE_WORKING, NULL, 3);
2303  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
2304  CB_FIELD (x)->flag_sign_leading = 1;
2305  CB_FIELD (x)->flag_sign_separate = 1;
2307  cb_debug_sub_2 = l;
2308 
2309  l = cb_build_filler ();
2310  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2311  CB_STORAGE_WORKING, NULL, 3);
2312  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2313  CB_FIELD (x)->flag_filler = 1;
2315 
2316  l = cb_build_reference ("DEBUG-SUB-3");
2317  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2318  CB_STORAGE_WORKING, NULL, 3);
2319  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
2320  CB_FIELD (x)->flag_sign_leading = 1;
2321  CB_FIELD (x)->flag_sign_separate = 1;
2323  cb_debug_sub_3 = l;
2324 
2325  l = cb_build_filler ();
2326  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2327  CB_STORAGE_WORKING, NULL, 3);
2328  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
2329  CB_FIELD (x)->flag_filler = 1;
2331 
2332  l = cb_build_reference ("DEBUG-CONTENTS");
2333  x = cb_build_field_tree (NULL, l, CB_FIELD(x),
2334  CB_STORAGE_WORKING, NULL, 3);
2335  CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(31)"));
2337  cb_debug_contents = l;
2338 
2339  cb_validate_field (CB_FIELD (assign));
2341 }
cb_tree cb_debug_sub_2
Definition: typeck.c:86
cb_tree cb_debug_name
Definition: typeck.c:84
cb_tree cb_build_filler(void)
Definition: tree.c:2591
#define CB_FIELD_ADD(x, y)
Definition: tree.h:1856
cb_tree cb_debug_line
Definition: typeck.c:83
cb_tree cb_build_field_tree(cb_tree level, cb_tree name, struct cb_field *last_field, enum cb_storage storage, struct cb_file *fn, const int expl_level)
Definition: field.c:90
#define CB_PICTURE(x)
Definition: tree.h:631
cb_tree cb_space
Definition: tree.c:127
cb_tree cb_build_picture(const char *str)
Definition: tree.c:1800
cb_tree cb_debug_item
Definition: typeck.c:82
cb_tree cb_debug_sub_1
Definition: typeck.c:85
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
cb_tree cb_debug_sub_3
Definition: typeck.c:87
struct cb_program * current_program
Definition: parser.c:168
#define CB_LIST_INIT(x)
Definition: tree.h:1851
cb_tree cb_debug_contents
Definition: typeck.c:88
struct cb_field * working_storage
Definition: tree.h:1276
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_decimal ( const int  )

Definition at line 1770 of file tree.c.

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

Referenced by decimal_alloc().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_direct ( const char *  ,
const unsigned  int 
)

Definition at line 1553 of file tree.c.

References cb_build_comment(), and CB_DIRECT.

Referenced by cb_check_needs_break(), and cb_emit_evaluate().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_display_mnemonic ( cb_tree  )

Definition at line 5340 of file typeck.c.

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.

Referenced by yyparse().

5341 {
5342  if (x == cb_error_node) {
5343  return cb_int0;
5344  }
5345  if (cb_ref (x) == cb_error_node) {
5346  return cb_int0;
5347  }
5348 
5349  switch (CB_SYSTEM_NAME (cb_ref (x))->token) {
5350  case CB_DEVICE_CONSOLE:
5351  case CB_DEVICE_SYSOUT:
5352  return cb_int0;
5353  case CB_DEVICE_SYSERR:
5354  return cb_int1;
5355  default:
5356  cb_error_x (x, _("Invalid output device"));
5357  return cb_int0;
5358  }
5359 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_SYSTEM_NAME(x)
Definition: tree.h:586
cb_tree cb_int1
Definition: tree.c:134
#define CB_DEVICE_SYSOUT
Definition: tree.h:154
#define CB_DEVICE_SYSERR
Definition: tree.h:155
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define _(s)
Definition: cobcrun.c:59
cb_tree cb_int0
Definition: tree.c:133
cb_tree cb_error_node
Definition: tree.c:140
#define CB_DEVICE_CONSOLE
Definition: tree.h:156

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_display_name ( cb_tree  )

Definition at line 5362 of file typeck.c.

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.

Referenced by yyparse().

5363 {
5364  const char *name;
5365  cb_tree sys;
5366 
5367  if (x == cb_error_node) {
5368  return cb_error_node;
5369  }
5370  name = CB_NAME (x);
5371  /* Allow direct reference to a device name */
5372  sys = lookup_system_name (name);
5373  if (sys) {
5374  switch (CB_SYSTEM_NAME (sys)->token) {
5375  case CB_DEVICE_CONSOLE:
5376  case CB_DEVICE_SYSOUT:
5377  if (!cb_relaxed_syntax_check) {
5378  cb_warning_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
5379  }
5380  return cb_int0;
5381  case CB_DEVICE_SYSERR:
5382  if (!cb_relaxed_syntax_check) {
5383  cb_warning_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
5384  }
5385  return cb_int1;
5386  default:
5387  cb_error_x (x, _("'%s' is not an output device"), name);
5388  return cb_error_node;
5389  }
5390  }
5391 
5392  cb_error_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
5393  return cb_error_node;
5394 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_SYSTEM_NAME(x)
Definition: tree.h:586
cb_tree cb_int1
Definition: tree.c:134
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
#define CB_DEVICE_SYSOUT
Definition: tree.h:154
#define CB_DEVICE_SYSERR
Definition: tree.h:155
#define _(s)
Definition: cobcrun.c:59
cb_tree lookup_system_name(const char *name)
Definition: reserved.c:2860
cb_tree cb_int0
Definition: tree.c:133
#define CB_NAME(x)
Definition: tree.h:904
cb_tree cb_error_node
Definition: tree.c:140
#define CB_DEVICE_CONSOLE
Definition: tree.h:156

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_expr ( cb_tree  )

Definition at line 3136 of file typeck.c.

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.

Referenced by yyparse().

3137 {
3138  cb_tree l;
3139  int op;
3140 
3141  cb_expr_init ();
3142 
3143  for (l = list; l; l = CB_CHAIN (l)) {
3144  op = CB_PURPOSE_INT (l);
3145  switch (op) {
3146  case '9':
3147  /* NUMERIC */
3148  cb_expr_shift_class ("cob_is_numeric");
3149  break;
3150  case 'A':
3151  /* ALPHABETIC */
3152  cb_expr_shift_class ("cob_is_alpha");
3153  break;
3154  case 'L':
3155  /* ALPHABETIC_LOWER */
3156  cb_expr_shift_class ("cob_is_lower");
3157  break;
3158  case 'U':
3159  /* ALPHABETIC_UPPER */
3160  cb_expr_shift_class ("cob_is_upper");
3161  break;
3162  case 'P':
3163  /* POSITIVE */
3164  cb_expr_shift_sign ('>');
3165  break;
3166  case 'N':
3167  /* NEGATIVE */
3168  cb_expr_shift_sign ('<');
3169  break;
3170  case 'O':
3171  /* OMITTED */
3172  if (current_statement) {
3174  }
3175  cb_expr_shift_class ("cob_is_omitted");
3176  break;
3177  case 'C':
3178  /* CLASS */
3180  break;
3181  default:
3182  cb_expr_shift (op, CB_VALUE (l));
3183  break;
3184  }
3185  }
3186 
3187  return cb_expr_finish ();
3188 }
static void cb_expr_shift(int token, cb_tree value)
Definition: typeck.c:2970
#define CB_PURPOSE_INT(x)
Definition: tree.h:1197
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void cb_expr_shift_class(const char *name)
Definition: typeck.c:2950
static void cb_expr_shift_sign(const int op)
Definition: typeck.c:2930
cb_tree null_check
Definition: tree.h:1144
#define CB_CLASS_NAME(x)
Definition: tree.h:562
static cb_tree cb_expr_finish(void)
Definition: typeck.c:3108
struct cb_statement * current_statement
Definition: parser.c:169
static void cb_expr_init(void)
Definition: typeck.c:2714

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_field ( cb_tree  )

Definition at line 2159 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_field_reference ( struct cb_field ,
cb_tree   
)

Definition at line 2604 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_field_tree ( cb_tree  ,
cb_tree  ,
struct cb_field ,
enum  cb_storage,
struct cb_file ,
const int   
)

Definition at line 90 of file field.c.

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, cb_field::parent, redefinition_warning(), cb_field::sister, cb_field::storage, cb_field::usage, and cb_reference::word.

Referenced by cb_build_debug_item(), and yyparse().

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;
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) {
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)) {
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 /* <- silence warnings */; 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  && p /* <- silence warnings */) {
210  dummy_fill = cb_build_filler ();
211  field_fill = CB_FIELD (cb_build_field (dummy_fill));
213  _("No previous data item of level %02d"),
214  f->level);
215  field_fill->level = f->level;
216  field_fill->flag_filler = 1;
217  field_fill->storage = storage;
218  field_fill->children = p->children;
219  field_fill->parent = p;
220  for (p = p->children; p; p = p->sister) {
221  p->parent = field_fill;
222  }
223  field_fill->parent->children = field_fill;
224  field_fill->sister = f;
225  f->parent = field_fill->parent;
226  /* last_field = field_fill; */
227  } else {
228  cb_error_x (name,
229  _("No previous data item of level %02d"),
230  f->level);
231  return cb_error_node;
232  }
233  }
234 
235  /* Inherit parents properties */
236  if (f->parent) {
237  f->usage = f->parent->usage;
238  f->indexes = f->parent->indexes;
242  }
243  return CB_TREE (f);
244 }
int indexes
Definition: tree.h:678
const char * name
Definition: tree.h:645
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
size_t cb_needs_01
Definition: field.c:37
unsigned int flag_filler
Definition: tree.h:714
cb_tree cb_build_filler(void)
Definition: tree.c:2591
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
struct cb_field * sister
Definition: tree.h:653
struct cb_field * children
Definition: tree.h:652
unsigned int flag_filler_ref
Definition: tree.h:897
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
int level
Definition: tree.h:673
unsigned char flag_is_global
Definition: tree.h:699
void redefinition_warning(cb_tree x, cb_tree y)
Definition: error.c:297
#define CB_VALUE(x)
Definition: tree.h:1193
int count
Definition: tree.h:867
unsigned int flag_item_78
Definition: tree.h:711
#define CB_FIELD_P(x)
Definition: tree.h:741
unsigned int flag_sign_leading
Definition: tree.h:704
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
static struct cb_field * last_real_field
Definition: field.c:41
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree items
Definition: tree.h:866
int cb_get_level(cb_tree x)
Definition: field.c:46
cb_tree cb_error_node
Definition: tree.c:140
struct cb_field * parent
Definition: tree.h:651
struct cb_program * current_program
Definition: parser.c:168
unsigned int flag_sign_separate
Definition: tree.h:703
unsigned int flag_has_external
Definition: tree.h:1316
enum cb_usage usage
Definition: tree.h:693
enum cb_storage storage
Definition: tree.h:692
struct cb_field * cb_field_founder(const struct cb_field *f)
Definition: tree.c:2227
#define CB_FIELD(x)
Definition: tree.h:740
unsigned char flag_external
Definition: tree.h:697
struct cb_word * word
Definition: tree.h:881

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_filler ( void  )

Definition at line 2591 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_func_prototype ( const cb_tree  ,
const cb_tree   
)

Definition at line 3265 of file tree.c.

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

Referenced by set_up_func_prototype().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_funcall ( const char *  ,
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  ,
const cb_tree   
)

Definition at line 2916 of file tree.c.

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

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

Here is the call graph for this function:

cb_tree cb_build_goto ( const cb_tree  ,
const cb_tree   
)

Definition at line 3118 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_identifier ( cb_tree  ,
const int   
)

Definition at line 1426 of file typeck.c.

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_3, CB_BUILD_FUNCALL_4, cb_build_reference(), 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, cb_field::children, COB_EC_BOUND_REF_MOD, COB_EC_BOUND_SUBSCRIPT, COB_EC_DATA_PTR_NULL, COB_EC_PROGRAM_ARG_OMITTED, COB_MAX_WORDLEN, current_statement, cb_field::depending, cb_reference::flag_all, cb_field::flag_any_length, cb_field::flag_is_pdiv_opt, 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::mem_offset, cb_field::name, cb_word::name, NULL, cb_statement::null_check, cb_field::occurs_max, cb_field::occurs_min, cb_field::odo_level, cb_field::offset, cb_reference::offset, cb_field::parent, cb_field::redefines, cb_field::size, cb_field::storage, cb_reference::subs, unlikely, cb_field::usage, cb_field::values, and cb_reference::word.

Referenced by yyparse().

1427 {
1428  struct cb_reference *r;
1429  struct cb_field *f;
1430  struct cb_field *p;
1431  const char *name;
1432  char full_name[COB_MAX_WORDLEN * 2 + 10];
1433  cb_tree xr;
1434  cb_tree v;
1435  cb_tree e1;
1436  cb_tree l;
1437  cb_tree sub;
1438  int offset;
1439  int length;
1440  int n;
1441  int numsubs;
1442  int refsubs;
1443  int pseudosize;
1444 
1445  if (x == cb_error_node) {
1446  return cb_error_node;
1447  }
1448 
1449  r = CB_REFERENCE (x);
1450  name = r->word->name;
1451 
1452  /* Resolve reference */
1453  v = cb_ref (x);
1454  if (v == cb_error_node) {
1455  return cb_error_node;
1456  }
1457 
1458  /* Check if it is a data name */
1459  if (!CB_FIELD_P (v)) {
1460  if (r->subs) {
1461  cb_error_x (x, _("'%s' cannot be subscripted"), name);
1462  return cb_error_node;
1463  }
1464  if (r->offset) {
1465  cb_error_x (x, _("'%s' cannot be reference modified"), name);
1466  return cb_error_node;
1467  }
1468  return x;
1469  }
1470  f = CB_FIELD (v);
1471 
1472  /* BASED check and check for OPTIONAL LINKAGE items */
1473  if (current_statement &&
1476  p = cb_field_founder (f);
1477  if (p->redefines) {
1478  p = p->redefines;
1479  }
1480  if (p == f) {
1481  sprintf(full_name, "'%s'", name);
1482  } else {
1483  sprintf(full_name, _("'%s' (accessed by '%s')"), p->name, name);
1484  }
1485  xr = cb_build_reference(full_name);
1486 
1489  if (p->flag_item_based ||
1490  (p->storage == CB_STORAGE_LINKAGE &&
1491  !p->flag_is_pdiv_parm)) {
1493  "cob_check_based",
1495  CB_BUILD_STRING0 (CB_REFERENCE(xr)->word->name));
1496  }
1497  }
1499  p->flag_is_pdiv_opt) {
1501  "cob_check_linkage",
1503  CB_BUILD_STRING0 (CB_REFERENCE(xr)->word->name), cb_int1);
1504  }
1505  }
1506 
1507  for (l = r->subs; l; l = CB_CHAIN (l)) {
1508  if (CB_BINARY_OP_P (CB_VALUE (l))) {
1509  /* Set special flag for codegen */
1510  CB_BINARY_OP(CB_VALUE(l))->flag = 1;
1511  }
1512  }
1513 
1514  /* Check the number of subscripts */
1515  numsubs = refsubs = cb_list_length (r->subs);
1516  cb_check_lit_subs (r, numsubs, f->indexes);
1517  if (subchk) {
1518  if (!f->indexes) {
1519  cb_error_x (x, _("'%s' has no OCCURS clause"), name);
1520  return cb_error_node;
1521  }
1522  numsubs = f->indexes - 1;
1523  } else {
1524  numsubs = f->indexes;
1525  }
1526  if (unlikely(!r->flag_all)) {
1527  if (refsubs != numsubs) {
1528  if (refsubs > numsubs) {
1529  goto refsubserr;
1530  } else if (refsubs < numsubs) {
1531  if (!cb_relaxed_syntax_check) {
1532  goto refsubserr;
1533  } else {
1534  cb_warning_x (x,
1535  _("Subscripts missing for '%s' - Defaulting to 1"),
1536  name);
1537  for (; refsubs < numsubs; ++refsubs) {
1538  CB_ADD_TO_CHAIN (cb_one, r->subs);
1539  }
1540  }
1541  }
1542  }
1543 
1544  /* Run-time check for ODO (including all the fields subordinate items) */
1546  for (p = f; p; p = p->children) {
1547  if (p->depending) {
1548  e1 = CB_BUILD_FUNCALL_4 ("cob_check_odo",
1550  cb_int (p->occurs_min),
1551  cb_int (p->occurs_max),
1553  ((CB_FIELD_PTR (p->depending)->name)));
1554  r->check = cb_list_add (r->check, e1);
1555  }
1556  }
1557  }
1558 
1559  /* Subscript check along with setting of table offset */
1560  if (r->subs) {
1561  l = r->subs;
1562  for (p = f; p; p = p->parent) {
1563  if (!p->flag_occurs) {
1564  continue;
1565  }
1566 
1567 #if 1 /* RXWRXW - Sub check */
1568  if (!l) {
1569  break;
1570  }
1571 #endif
1572  sub = cb_check_integer_value (CB_VALUE (l));
1573  l = CB_CHAIN (l);
1574  if (sub == cb_error_node) {
1575  continue;
1576  }
1577 
1578  /* Compile-time check for all literals */
1579  if (CB_LITERAL_P (sub)) {
1580  n = cb_get_int (sub);
1581  if (n < 1 || n > p->occurs_max) {
1582  cb_error_x (x, _("Subscript of '%s' out of bounds: %d"),
1583  name, n);
1584  }
1585  if (p==f) {
1586  /* Only valid for single subscript (!) */
1587  f->mem_offset = f->size * (n - 1);
1588  }
1589  }
1590 
1591  /* Run-time check for all non-literals */
1593  if (p->depending) {
1594  e1 = CB_BUILD_FUNCALL_4 ("cob_check_subscript",
1595  cb_build_cast_int (sub),
1596  cb_int1,
1598  CB_BUILD_STRING0 (name));
1599  r->check = cb_list_add (r->check, e1);
1600  } else {
1601  if (!CB_LITERAL_P (sub)) {
1602  e1 = CB_BUILD_FUNCALL_4 ("cob_check_subscript",
1603  cb_build_cast_int (sub),
1604  cb_int1,
1605  cb_int (p->occurs_max),
1606  CB_BUILD_STRING0 (name));
1607  r->check = cb_list_add (r->check, e1);
1608  }
1609  }
1610  }
1611  }
1612  }
1613 
1614  }
1615 
1616  if (subchk) {
1617  r->subs = cb_list_reverse (r->subs);
1618  r->subs = cb_list_add (r->subs, cb_int1);
1619  r->subs = cb_list_reverse (r->subs);
1620  }
1621 
1622  /* Reference modification check */
1623  if ( f->usage == CB_USAGE_NATIONAL ) {
1624  pseudosize = f->size / 2;
1625  } else {
1626  pseudosize = f->size;
1627  }
1628  if (r->offset) {
1629  /* Compile-time check */
1630  if (CB_LITERAL_P (r->offset)) {
1631  offset = cb_get_int (r->offset);
1632  if (f->flag_any_length) {
1633  if (offset < 1) {
1634  cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset);
1635  } else if (r->length && CB_LITERAL_P (r->length)) {
1636  length = cb_get_int (r->length);
1637  if (length < 1) {
1638  cb_error_x (x, _("Length of '%s' out of bounds: %d"),
1639  name, length);
1640  }
1641  }
1642  } else {
1643  if (offset < 1 || offset > pseudosize) {
1644  cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset);
1645  } else if (r->length && CB_LITERAL_P (r->length)) {
1646  length = cb_get_int (r->length);
1647  if (length < 1 || length > pseudosize - offset + 1) {
1648  cb_error_x (x, _("Length of '%s' out of bounds: %d"),
1649  name, length);
1650  }
1651  }
1652  }
1653  }
1654 
1655  /* Run-time check */
1657  if (f->flag_any_length || !CB_LITERAL_P (r->offset) ||
1658  (r->length && !CB_LITERAL_P (r->length))) {
1659  e1 = CB_BUILD_FUNCALL_4 ("cob_check_ref_mod",
1661  r->length ?
1662  cb_build_cast_int (r->length) :
1663  cb_int1,
1664  f->flag_any_length ?
1665  CB_BUILD_CAST_LENGTH (v) :
1666  cb_int (pseudosize),
1667  CB_BUILD_STRING0 (f->name));
1668  r->check = cb_list_add (r->check, e1);
1669  }
1670  }
1671  }
1672 
1673  if (f->storage == CB_STORAGE_CONSTANT) {
1674  return CB_VALUE (f->values);
1675  }
1676 
1677  return x;
1678 
1679 refsubserr:
1680  switch (numsubs) {
1681  case 0:
1682  cb_error_x (x, _("'%s' cannot be subscripted"), name);
1683  break;
1684  case 1:
1685  cb_error_x (x, _("'%s' requires 1 subscript"), name);
1686  break;
1687  default:
1688  cb_error_x (x, _("'%s' requires %d subscripts"),
1689  name, f->indexes);
1690  break;
1691  }
1692  return cb_error_node;
1693 }
int indexes
Definition: tree.h:678
cb_tree check
Definition: tree.h:880
const char * name
Definition: tree.h:645
int occurs_max
Definition: tree.h:677
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_int1
Definition: tree.c:134
unsigned int flag_is_pdiv_opt
Definition: tree.h:725
unsigned int odo_level
Definition: tree.h:687
unsigned int flag_any_length
Definition: tree.h:712
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
static void cb_check_lit_subs(struct cb_reference *r, const int numsubs, const int numindex)
Definition: typeck.c:746
unsigned int flag_no_based
Definition: tree.h:1149
struct cb_field * children
Definition: tree.h:652
int occurs_min
Definition: tree.h:676
#define CB_FIELD_PTR(x)
Definition: tree.h:745
int cb_get_int(const cb_tree x)
Definition: tree.c:1101
cb_tree cb_build_field_reference(struct cb_field *f, cb_tree ref)
Definition: tree.c:2604
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define CB_VALUE(x)
Definition: tree.h:1193
const char * name
Definition: tree.h:865
#define COB_MAX_WORDLEN
Definition: common.h:574
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
#define CB_BINARY_OP_P(x)
Definition: tree.h:937
int cb_list_length(cb_tree l)
Definition: tree.c:1342
cb_tree depending
Definition: tree.h:647
unsigned int flag_all
Definition: tree.h:888
int offset
Definition: tree.h:675
#define CB_FIELD_P(x)
Definition: tree.h:741
unsigned int flag_is_pdiv_parm
Definition: tree.h:724
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define unlikely(x)
Definition: common.h:437
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree offset
Definition: tree.h:878
unsigned int flag_occurs
Definition: tree.h:702
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_one
Definition: tree.c:126
cb_tree cb_int(const int n)
Definition: tree.c:1488
int size
Definition: tree.h:672
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
cb_tree cb_error_node
Definition: tree.c:140
struct cb_field * parent
Definition: tree.h:651
cb_tree cb_build_address(cb_tree x)
Definition: typeck.c:1357
static cb_tree cb_check_integer_value(cb_tree x)
Definition: typeck.c:666
#define CB_ADD_TO_CHAIN(x, y)
Definition: tree.h:1854
#define CB_BUILD_STRING0(str)
Definition: tree.h:1849
#define CB_EXCEPTION_ENABLE(id)
Definition: cobc.h:243
int mem_offset
Definition: tree.h:681
#define CB_BINARY_OP(x)
Definition: tree.h:936
cb_tree subs
Definition: tree.h:877
cb_tree null_check
Definition: tree.h:1144
#define CB_BUILD_CAST_LENGTH(x)
Definition: tree.h:1843
cb_tree length
Definition: tree.h:879
cb_tree cb_list_reverse(cb_tree l)
Definition: tree.c:1327
struct cb_field * redefines
Definition: tree.h:654
cb_tree values
Definition: tree.h:648
cb_tree cb_build_cast_int(const cb_tree val)
Definition: tree.c:2964
enum cb_usage usage
Definition: tree.h:693
struct cb_statement * current_statement
Definition: parser.c:169
enum cb_storage storage
Definition: tree.h:692
struct cb_field * cb_field_founder(const struct cb_field *f)
Definition: tree.c:2227
#define CB_FIELD(x)
Definition: tree.h:740
struct cb_word * word
Definition: tree.h:881
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315
unsigned int flag_item_based
Definition: tree.h:713

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_if ( const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const unsigned  int 
)

Definition at line 3132 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_if_check_break ( cb_tree  ,
cb_tree   
)

Definition at line 5671 of file typeck.c.

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

Referenced by yyparse().

5672 {
5673  cb_tree stmt_lis;
5674 
5675  stmt_lis = cb_check_needs_break (stmts);
5676  return cb_build_if (cond, stmt_lis, NULL, 0);
5677 }
static cb_tree cb_check_needs_break(cb_tree stmt)
Definition: typeck.c:523
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_build_if(const cb_tree test, const cb_tree stmt1, const cb_tree stmt2, const unsigned int is_if)
Definition: tree.c:3132

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_implicit_field ( cb_tree  ,
const int   
)

Definition at line 2175 of file tree.c.

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

Referenced by cb_validate_program_data(), and finalize_file().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_index ( cb_tree  ,
cb_tree  ,
const unsigned  int,
struct cb_field  
)

Definition at line 1337 of file typeck.c.

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.

Referenced by cb_build_length(), cb_build_registers(), and yyparse().

1339 {
1340  struct cb_field *f;
1341 
1342  f = CB_FIELD (cb_build_field (x));
1343  f->usage = CB_USAGE_INDEX;
1344  cb_validate_field (f);
1345  if (values) {
1346  f->values = CB_LIST_INIT (values);
1347  }
1348  if (qual) {
1349  f->index_qual = qual;
1350  }
1351  f->flag_indexed_by = !!indexed_by;
1353  return x;
1354 }
#define CB_FIELD_ADD(x, y)
Definition: tree.h:1856
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
Definition: tree.h:643
unsigned int flag_indexed_by
Definition: tree.h:721
struct cb_program * current_program
Definition: parser.c:168
#define CB_LIST_INIT(x)
Definition: tree.h:1851
struct cb_field * working_storage
Definition: tree.h:1276
struct cb_field * index_qual
Definition: tree.h:656
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338
cb_tree values
Definition: tree.h:648
enum cb_usage usage
Definition: tree.h:693
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_initialize ( const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const unsigned  int,
const unsigned  int,
const unsigned  int 
)

Definition at line 3028 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_inspect_region_start ( void  )

Definition at line 5961 of file typeck.c.

References CB_BUILD_FUNCALL_0, and CB_LIST_INIT.

Referenced by yyparse().

5962 {
5963  return CB_LIST_INIT (CB_BUILD_FUNCALL_0 ("cob_inspect_start"));
5964 }
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define CB_LIST_INIT(x)
Definition: tree.h:1851

Here is the caller graph for this function:

cb_tree cb_build_intrinsic ( cb_tree  ,
cb_tree  ,
cb_tree  ,
const int   
)

Definition at line 3304 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_label ( cb_tree  ,
struct cb_label  
)

Definition at line 2988 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_length ( cb_tree  )

Definition at line 1781 of file typeck.c.

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.

Referenced by cb_build_intrinsic(), and yyparse().

1782 {
1783  struct cb_field *f;
1784  struct cb_literal *l;
1785  cb_tree temp;
1786  char buff[32];
1787 
1788  if (x == cb_error_node) {
1789  return cb_error_node;
1790  }
1791  if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) {
1792  return cb_error_node;
1793  }
1794 
1795  if (CB_LITERAL_P (x)) {
1796  l = CB_LITERAL (x);
1797  sprintf (buff, "%d", (int)l->size);
1798  return cb_build_numeric_literal (0, buff, 0);
1799  }
1800  if (CB_INTRINSIC_P (x)) {
1801  return cb_build_any_intrinsic (CB_LIST_INIT (x));
1802  }
1803  if (CB_REF_OR_FIELD_P (x)) {
1804  if (CB_REFERENCE_P (x) && CB_REFERENCE (x)->offset) {
1805  return cb_build_any_intrinsic (CB_LIST_INIT (x));
1806  }
1807  f = CB_FIELD (cb_ref (x));
1808  if (f->flag_any_length) {
1809  return cb_build_any_intrinsic (CB_LIST_INIT (x));
1810  }
1811  if (cb_field_variable_size (f) == NULL) {
1812  sprintf (buff, "%d", cb_field_size (x));
1813  return cb_build_numeric_literal (0, buff, 0);
1814  }
1815  }
1816  temp = cb_build_index (cb_build_filler (), NULL, 0, NULL);
1817  CB_FIELD (cb_ref (temp))->usage = CB_USAGE_LENGTH;
1818  CB_FIELD (cb_ref (temp))->count++;
1820  return temp;
1821 }
cb_tree cb_build_any_intrinsic(cb_tree args)
Definition: tree.c:3295
#define CB_REFERENCE_P(x)
Definition: tree.h:902
static int cb_field_size(const cb_tree x)
Definition: typeck.c:790
cb_tree cb_build_filler(void)
Definition: tree.c:2591
unsigned int flag_any_length
Definition: tree.h:712
#define CB_LITERAL(x)
Definition: tree.h:601
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
cb_tree cb_build_index(cb_tree x, cb_tree values, const unsigned int indexed_by, struct cb_field *qual)
Definition: typeck.c:1337
struct cb_field * cb_field_variable_size(const struct cb_field *f)
Definition: tree.c:2239
#define CB_LITERAL_P(x)
Definition: tree.h:602
cb_tree cb_build_numeric_literal(const int sign, const void *data, const int scale)
Definition: tree.c:1681
Definition: tree.h:643
static cb_tree cb_build_length_1(cb_tree x)
Definition: typeck.c:1696
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_error_node
Definition: tree.c:140
#define CB_INTRINSIC_P(x)
Definition: tree.h:1002
cb_tree cb_build_assign(const cb_tree var, const cb_tree val)
Definition: tree.c:3014
#define CB_LIST_INIT(x)
Definition: tree.h:1851
#define cb_emit(x)
Definition: typeck.c:75
cob_u32_t size
Definition: tree.h:594
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_list ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 1293 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_locale_name ( cb_tree  ,
cb_tree   
)

Definition at line 1645 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_move ( cb_tree  ,
cb_tree   
)

Definition at line 7333 of file typeck.c.

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.

Referenced by cb_build_add(), cb_build_div(), cb_build_mul(), cb_build_sub(), cb_check_field_debug(), cb_emit_close(), cb_emit_move(), cb_emit_open(), cb_emit_read(), cb_emit_release(), cb_emit_return(), cb_emit_rewrite(), cb_emit_set_false(), cb_emit_set_to(), cb_emit_set_true(), cb_emit_write(), emit_move_corresponding(), and output_move().

7334 {
7335  struct cb_reference *x;
7336 
7337  if (src == cb_error_node || dst == cb_error_node) {
7338  return cb_error_node;
7339  }
7340 
7341  if (validate_move (src, dst, 0) < 0) {
7342  return cb_error_node;
7343  }
7344 
7345 #if 0 /* Flag receiving */
7346  if (CB_REFERENCE_P (src)) {
7347  CB_REFERENCE (src)->flag_receiving = 0;
7348  }
7349 #endif
7350 
7351  if (CB_REFERENCE_P (dst)) {
7352  /* Clone reference */
7353  x = cobc_parse_malloc (sizeof(struct cb_reference));
7354  *x = *CB_REFERENCE (dst);
7355  x->flag_receiving = 1;
7356  dst = CB_TREE (x);
7357  }
7358 
7359  if ((src == cb_space || src == cb_low ||
7360  src == cb_high || src == cb_quote) &&
7363  src = cb_zero;
7364  }
7365 
7366  if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER ||
7367  CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
7368  return cb_build_assign (dst, src);
7369  }
7370 
7371  if (CB_REFERENCE_P (src) &&
7373  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7374  }
7375  if (CB_INDEX_P (dst)) {
7376  if (src == cb_null) {
7377  return cb_build_assign (dst, cb_zero);
7378  }
7379  return cb_build_assign (dst, src);
7380  }
7381 
7382  if (CB_INDEX_P (src)) {
7383  return CB_BUILD_FUNCALL_2 ("cob_set_int", dst,
7384  cb_build_cast_int (src));
7385  }
7386 
7387  if (CB_INTRINSIC_P (src) || CB_INTRINSIC_P (dst)) {
7388  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7389  }
7390 
7391  if (CB_REFERENCE_P (src) && CB_REFERENCE (src)->check) {
7392  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7393  }
7394  if (CB_REFERENCE_P (dst) && CB_REFERENCE (dst)->check) {
7395  return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
7396  }
7397 
7398  /* Output optimal code */
7399  if (src == cb_zero) {
7400  return cb_build_move_zero (dst);
7401  } else if (src == cb_space) {
7402  return cb_build_move_space (dst);
7403  } else if (src == cb_high) {
7404  return cb_build_move_high (dst);
7405  } else if (src == cb_low) {
7406  return cb_build_move_low (dst);
7407  } else if (src == cb_quote) {
7408  return cb_build_move_quote (dst);
7409  } else if (CB_LITERAL_P (src)) {
7410  return cb_build_move_literal (src, dst);
7411  }
7412  return cb_build_move_field (src, dst);
7413 }
#define CB_TREE(x)
Definition: tree.h:440
static cb_tree cb_build_move_field(cb_tree src, cb_tree dst)
Definition: typeck.c:7271
#define CB_REFERENCE_P(x)
Definition: tree.h:902
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack check
Definition: flag.def:99
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
static cb_tree cb_build_move_zero(cb_tree x)
Definition: typeck.c:6843
cb_tree cb_zero
Definition: tree.c:125
cb_tree cb_quote
Definition: tree.c:132
cb_tree cb_space
Definition: tree.c:127
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define CB_TREE_CLASS(x)
Definition: tree.h:442
static cb_tree cb_build_move_literal(cb_tree src, cb_tree dst)
Definition: typeck.c:7038
int validate_move(cb_tree src, cb_tree dst, const unsigned int is_value)
Definition: typeck.c:6167
static cb_tree cb_build_move_quote(cb_tree x)
Definition: typeck.c:6904
strict implicit external value
Definition: warning.def:54
#define CB_INDEX_P(x)
Definition: tree.h:750
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
static cb_tree cb_build_move_high(cb_tree x)
Definition: typeck.c:6866
#define CB_REFERENCE(x)
Definition: tree.h:901
static cb_tree cb_build_move_space(cb_tree x)
Definition: typeck.c:6827
cb_tree cb_error_node
Definition: tree.c:140
#define CB_INTRINSIC_P(x)
Definition: tree.h:1002
unsigned int flag_receiving
Definition: tree.h:887
static cb_tree cb_build_move_low(cb_tree x)
Definition: typeck.c:6885
cb_tree cb_null
Definition: tree.c:124
cb_tree cb_high
Definition: tree.c:129
cb_tree cb_build_assign(const cb_tree var, const cb_tree val)
Definition: tree.c:3014
#define CB_ALPHABET_NAME_P(x)
Definition: tree.h:551
cb_tree cb_build_cast_int(const cb_tree val)
Definition: tree.c:2964
cb_tree cb_low
Definition: tree.c:128

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_numeric_literal ( const int  ,
const void *  ,
const int   
)

Definition at line 1681 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_numsize_literal ( const void *  ,
const size_t  ,
const int   
)

Definition at line 1699 of file tree.c.

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

Referenced by cb_check_lit_subs().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform ( const enum  cb_perform_type)

Definition at line 3149 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_exit ( struct cb_label )

Definition at line 7574 of file typeck.c.

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

Referenced by yyparse().

7575 {
7576  cb_tree x;
7577 
7579  CB_PERFORM (x)->data = CB_TREE (label);
7580  return x;
7581 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_PERFORM(x)
Definition: tree.h:1118
cb_tree cb_build_perform(const enum cb_perform_type type)
Definition: tree.c:3149

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_forever ( cb_tree  )

Definition at line 7561 of file typeck.c.

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

Referenced by yyparse().

7562 {
7563  cb_tree x;
7564 
7565  if (body == cb_error_node) {
7566  return cb_error_node;
7567  }
7569  CB_PERFORM (x)->body = body;
7570  return x;
7571 }
cb_tree body
Definition: tree.h:1108
#define CB_PERFORM(x)
Definition: tree.h:1118
cb_tree cb_error_node
Definition: tree.c:140
cb_tree cb_build_perform(const enum cb_perform_type type)
Definition: tree.c:3149

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_once ( cb_tree  )

Definition at line 7523 of file typeck.c.

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

Referenced by cb_emit_sort_input(), cb_emit_sort_output(), and yyparse().

7524 {
7525  cb_tree x;
7526 
7527  if (body == cb_error_node) {
7528  return cb_error_node;
7529  }
7531  CB_PERFORM (x)->body = body;
7532  return x;
7533 }
cb_tree body
Definition: tree.h:1108
#define CB_PERFORM(x)
Definition: tree.h:1118
cb_tree cb_error_node
Definition: tree.c:140
cb_tree cb_build_perform(const enum cb_perform_type type)
Definition: tree.c:3149

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_times ( cb_tree  )

Definition at line 7536 of file typeck.c.

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

Referenced by yyparse().

7537 {
7538  cb_tree x;
7539 
7540  if (cb_check_integer_value (times) == cb_error_node) {
7541  return cb_error_node;
7542  }
7543 
7545  CB_PERFORM (x)->data = times;
7546  return x;
7547 }
#define CB_PERFORM(x)
Definition: tree.h:1118
cb_tree cb_error_node
Definition: tree.c:140
static cb_tree cb_check_integer_value(cb_tree x)
Definition: typeck.c:666
cb_tree cb_build_perform(const enum cb_perform_type type)
Definition: tree.c:3149

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_until ( cb_tree  ,
cb_tree   
)

Definition at line 7550 of file typeck.c.

References cb_build_perform(), CB_PERFORM, and CB_PERFORM_UNTIL.

Referenced by yyparse().

7551 {
7552  cb_tree x;
7553 
7555  CB_PERFORM (x)->test = condition;
7556  CB_PERFORM (x)->varying = varying;
7557  return x;
7558 }
#define CB_PERFORM(x)
Definition: tree.h:1118
cb_tree cb_build_perform(const enum cb_perform_type type)
Definition: tree.c:3149
cb_tree varying
Definition: tree.h:1110

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_varying ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 3160 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_picture ( const char *  )

Definition at line 1800 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_ppointer ( cb_tree  )

Definition at line 1824 of file typeck.c.

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

Referenced by yyparse().

1825 {
1826  struct cb_field *f;
1827 
1828  if (x == cb_error_node ||
1829  (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) {
1830  return cb_error_node;
1831  }
1832 
1833  if (CB_REFERENCE_P (x)) {
1834  f = CB_FIELD_PTR (cb_ref(x));
1835  f->count++;
1836  }
1837  return CB_BUILD_CAST_PPOINTER (x);
1838 }
#define CB_REFERENCE_P(x)
Definition: tree.h:902
#define CB_FIELD_PTR(x)
Definition: tree.h:745
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_BUILD_CAST_PPOINTER(x)
Definition: tree.h:1844
Definition: tree.h:643
int count
Definition: tree.h:680
cb_tree cb_error_node
Definition: tree.c:140

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_program* cb_build_program ( struct cb_program ,
const int   
)

Definition at line 1400 of file tree.c.

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

Referenced by set_up_program(), and yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

char* cb_build_program_id ( cb_tree  ,
cb_tree  ,
const cob_u32_t   
)

Definition at line 1190 of file typeck.c.

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

Referenced by set_up_program(), and yyparse().

1191 {
1192  const char *name_str;
1193  char *s;
1194  unsigned char *p;
1195 
1196  /* Set the program name */
1197  if (CB_LITERAL_P (name)) {
1198  current_program->program_name = (char *)CB_LITERAL (name)->data;
1199  } else {
1201  }
1202 
1203  /* Set and encode the PROGRAM-ID */
1204  if (alt_name) {
1205  name_str = (const char *)CB_LITERAL (alt_name)->data;
1206  } else if (CB_LITERAL_P (name)) {
1207  name_str = (const char *)CB_LITERAL (name)->data;
1208  } else {
1209  name_str = CB_NAME (name);
1210  }
1212  s = cb_encode_program_id (name_str);
1213 
1215 
1216  /* Convert function names to upper case */
1217  if (is_func) {
1218  for (p = (unsigned char *)s; *p; ++p) {
1219  if (islower ((int)*p)) {
1220  *p = (cob_u8_t)toupper ((int)*p);
1221  }
1222  }
1223  }
1224  return s;
1225 }
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define cob_u8_t
Definition: common.h:27
char * cb_encode_program_id(const char *name)
Definition: typeck.c:1132
#define CB_NAME(x)
Definition: tree.h:904
void * cobc_strdup(const char *dupstr)
Definition: cobc.c:669
const char * program_name
Definition: tree.h:1243
struct cb_program * current_program
Definition: parser.c:168
size_t cobc_check_valid_name(const char *name, const unsigned int prechk)
Definition: cobc.c:1142
char * orig_program_id
Definition: tree.h:1246

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_reference ( const char *  )

Definition at line 2572 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_build_registers ( void  )

Definition at line 1051 of file typeck.c.

References cb_build_alphanumeric_literal(), cb_build_constant(), cb_build_field(), cb_build_index(), cb_build_picture(), cb_build_reference(), cb_program::cb_call_params, CB_FIELD_ADD, CB_FIELD_PTR, cb_intr_whencomp, CB_LIST_INIT, CB_PICTURE, cb_program::cb_return_code, cb_program::cb_sort_return, CB_USAGE_BINARY, cb_validate_field(), cb_zero, current_program, cb_program::nested_level, NULL, and cb_program::working_storage.

Referenced by set_up_program(), and yyparse().

1052 {
1053 #if !defined(__linux__) && !defined(__CYGWIN__) && defined(HAVE_TIMEZONE)
1054  long contz;
1055 #endif
1056  cb_tree r;
1057  cb_tree x;
1058  struct tm *tlt;
1059  time_t t;
1060  char buff[48];
1061 
1062  /* RETURN-CODE */
1063  if (!current_program->nested_level) {
1064  x = cb_build_index (cb_build_reference ("RETURN-CODE"),
1065  cb_zero, 0, NULL);
1066  CB_FIELD_PTR (x)->special_index = 1;
1068  }
1069 
1070  /* SORT-RETURN */
1071  x = cb_build_index (cb_build_reference ("SORT-RETURN"),
1072  cb_zero, 0, NULL);
1073  CB_FIELD_PTR (x)->flag_no_init = 1;
1075 
1076  /* NUMBER-OF-CALL-PARAMETERS */
1077  x = cb_build_index (cb_build_reference ("NUMBER-OF-CALL-PARAMETERS"),
1078  cb_zero, 0, NULL);
1079  CB_FIELD_PTR (x)->flag_no_init = 1;
1080  CB_FIELD_PTR (x)->flag_local = 1;
1081  CB_FIELD_PTR (x)->special_index = 2;
1083 
1084  /* TALLY */
1085  if (current_program->nested_level == 0) {
1086  r = cb_build_reference ("TALLY");
1087  x = cb_build_field (r);
1088  CB_FIELD_PTR (x)->usage = CB_USAGE_BINARY;
1089  CB_FIELD_PTR (x)->pic = CB_PICTURE (cb_build_picture ("9(5)"));
1091  CB_FIELD_PTR (x)->values = CB_LIST_INIT (cb_zero);
1092  CB_FIELD_PTR (x)->flag_no_init = 1;
1093  CB_FIELD_PTR (x)->flag_is_global = 1;
1095  }
1096 
1097  t = time (NULL);
1098  tlt = localtime (&t);
1099  /* Leap seconds ? */
1100  if (tlt->tm_sec >= 60) {
1101  tlt->tm_sec = 59;
1102  }
1103 
1104  /* WHEN-COMPILED */
1105  memset (buff, 0, sizeof (buff));
1106  strftime (buff, (size_t)17, "%m/%d/%y%H.%M.%S", tlt);
1107  cb_build_constant (cb_build_reference ("WHEN-COMPILED"),
1108  cb_build_alphanumeric_literal (buff, (size_t)16));
1109 
1110  /* FUNCTION WHEN-COMPILED */
1111  memset (buff, 0, sizeof (buff));
1112 #if defined(__linux__) || defined(__CYGWIN__)
1113  strftime (buff, (size_t)22, "%Y%m%d%H%M%S00%z", tlt);
1114 #elif defined(HAVE_TIMEZONE)
1115  strftime (buff, (size_t)17, "%Y%m%d%H%M%S00", tlt);
1116  if (timezone <= 0) {
1117  contz = -timezone;
1118  buff[16] = '+';
1119  } else {
1120  contz = timezone;
1121  buff[16] = '-';
1122  }
1123  sprintf (&buff[17], "%2.2ld%2.2ld", contz / 3600, contz % 60);
1124 #else
1125  strftime (buff, (size_t)22, "%Y%m%d%H%M%S0000000", tlt);
1126 #endif
1127  cb_intr_whencomp = cb_build_alphanumeric_literal (buff, (size_t)21);
1128 
1129 }
cb_tree cb_intr_whencomp
Definition: tree.c:142
cb_tree cb_build_constant(cb_tree name, cb_tree value)
Definition: tree.c:2189
#define CB_FIELD_ADD(x, y)
Definition: tree.h:1856
#define CB_FIELD_PTR(x)
Definition: tree.h:745
int nested_level
Definition: tree.h:1295
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
cb_tree cb_build_index(cb_tree x, cb_tree values, const unsigned int indexed_by, struct cb_field *qual)
Definition: typeck.c:1337
cb_tree cb_zero
Definition: tree.c:125
#define CB_PICTURE(x)
Definition: tree.h:631
cb_tree cb_build_picture(const char *str)
Definition: tree.c:1800
cb_tree cb_build_alphanumeric_literal(const void *data, const size_t size)
Definition: tree.c:1716
cb_tree cb_call_params
Definition: tree.h:1267
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_return_code
Definition: tree.h:1265
cb_tree cb_sort_return
Definition: tree.h:1266
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
struct cb_program * current_program
Definition: parser.c:168
#define CB_LIST_INIT(x)
Definition: tree.h:1851
struct cb_field * working_storage
Definition: tree.h:1276
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_replacing_all ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5926 of file typeck.c.

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

Referenced by yyparse().

5927 {
5928  validate_inspect (x, y, 1);
5929  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_all", y, x));
5930 }
static void validate_inspect(cb_tree x, cb_tree y, const unsigned int replconv)
Definition: typeck.c:5714
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_replacing_characters ( cb_tree  ,
cb_tree   
)

Definition at line 5916 of file typeck.c.

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

Referenced by yyparse().

5917 {
5918  if (CB_LITERAL_P (x) && CB_LITERAL(x)->size != 1) {
5920  _("Operand has wrong size"));
5921  }
5922  return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", x));
5923 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define _(s)
Definition: cobcrun.c:59
struct cb_statement * current_statement
Definition: parser.c:169
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_replacing_first ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5940 of file typeck.c.

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

Referenced by yyparse().

5941 {
5942  validate_inspect (x, y, 1);
5943  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_first", y, x));
5944 }
static void validate_inspect(cb_tree x, cb_tree y, const unsigned int replconv)
Definition: typeck.c:5714
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_replacing_leading ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5933 of file typeck.c.

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

Referenced by yyparse().

5934 {
5935  validate_inspect (x, y, 1);
5936  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_leading", y, x));
5937 }
static void validate_inspect(cb_tree x, cb_tree y, const unsigned int replconv)
Definition: typeck.c:5714
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_replacing_trailing ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5947 of file typeck.c.

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

Referenced by yyparse().

5948 {
5949  validate_inspect (x, y, 1);
5950  return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_trailing", y, x));
5951 }
static void validate_inspect(cb_tree x, cb_tree y, const unsigned int replconv)
Definition: typeck.c:5714
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_search ( const int  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree  ,
const cb_tree   
)

Definition at line 3049 of file tree.c.

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

Referenced by cb_emit_search(), and cb_emit_search_all().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_section_name ( cb_tree  ,
const int   
)

Definition at line 1251 of file typeck.c.

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

Referenced by yyparse().

1252 {
1253  cb_tree x;
1254 
1255  if (name == cb_error_node) {
1256  return cb_error_node;
1257  }
1258 
1259  if (CB_WORD_COUNT (name) > 0) {
1260  x = CB_VALUE (CB_WORD_ITEMS (name));
1261  /* Used as a non-label name or used as a section name.
1262  Duplicate paragraphs are allowed if not referenced;
1263  Checked in typeck.c */
1264  if (!CB_LABEL_P (x) || sect_or_para == 0 ||
1265  (sect_or_para && CB_LABEL_P (x) &&
1266  CB_LABEL (x)->flag_section)) {
1267  redefinition_error (name);
1268  return cb_error_node;
1269  }
1270  }
1271 
1272  return name;
1273 }
#define CB_LABEL(x)
Definition: tree.h:801
#define CB_LABEL_P(x)
Definition: tree.h:802
#define CB_WORD_ITEMS(x)
Definition: tree.h:906
#define CB_VALUE(x)
Definition: tree.h:1193
void redefinition_error(cb_tree x)
Definition: error.c:284
cb_tree cb_error_node
Definition: tree.c:140
#define CB_WORD_COUNT(x)
Definition: tree.h:905

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_set_attribute ( const struct cb_field ,
const int  ,
const int   
)

Definition at line 3226 of file tree.c.

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

Referenced by cb_emit_set_attribute().

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

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_statement* cb_build_statement ( const char *  )

Definition at line 3201 of file tree.c.

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

Referenced by begin_implicit_statement(), and begin_statement().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_string ( const void *  ,
const size_t   
)

Definition at line 1526 of file tree.c.

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

Referenced by cb_build_move_literal().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_sub ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 4058 of file typeck.c.

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, COB_POINTER_MANIP, cb_field::count, and optimize_defs.

Referenced by cb_emit_arithmetic(), cb_emit_set_up_down(), and yyparse().

4059 {
4060  cb_tree opt;
4061  struct cb_field *f;
4062 
4063 #ifdef COB_NON_ALIGNED
4064  if (CB_INDEX_P (v)) {
4065  return cb_build_move (cb_build_binary_op (v, '-', n), v);
4066  }
4067  if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
4069  return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", v, n, cb_int1);
4070  }
4071 #else
4072  if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
4073  return cb_build_move (cb_build_binary_op (v, '-', n), v);
4074  }
4075 #endif
4076 
4077  if (CB_REF_OR_FIELD_P (v)) {
4078  f = CB_FIELD_PTR (v);
4079  f->count++;
4080  }
4081  if (CB_REF_OR_FIELD_P (n)) {
4082  f = CB_FIELD_PTR (n);
4083  f->count++;
4084  }
4085  opt = build_store_option (v, round_opt);
4086  if (opt == cb_int0 && cb_fits_int (n)) {
4087  return cb_build_optim_sub (v, n);
4088  }
4089  return CB_BUILD_FUNCALL_3 ("cob_sub", v, n, opt);
4090 }
static cb_tree cb_build_optim_sub(cb_tree v, cb_tree n)
Definition: typeck.c:3951
cb_tree cb_int1
Definition: tree.c:134
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_FIELD_PTR(x)
Definition: tree.h:745
#define CB_TREE_CLASS(x)
Definition: tree.h:442
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
#define CB_INDEX_P(x)
Definition: tree.h:750
Definition: tree.h:643
cb_tree cb_int0
Definition: tree.c:133
int count
Definition: tree.h:680
int cb_fits_int(const cb_tree x)
Definition: tree.c:914
static cb_tree build_store_option(cb_tree x, cb_tree round_opt)
Definition: typeck.c:3193
cob_u32_t optimize_defs[COB_OPTIM_MAX]
Definition: cobc.c:182
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
cb_tree cb_build_binary_op(cb_tree x, const int op, cb_tree y)
Definition: tree.c:2827

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_build_symbolic_chars ( const cb_tree  ,
const cb_tree   
)

Definition at line 2289 of file tree.c.

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

Referenced by cb_validate_program_environment().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_system_name ( const enum  cb_system_name_category,
const int   
)

Definition at line 1667 of file tree.c.

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

Referenced by lookup_system_name().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_all ( void  )

Definition at line 5874 of file typeck.c.

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

Referenced by yyparse().

5875 {
5876  if (inspect_data == NULL) {
5878  _("Data name expected before ALL"));
5879  }
5880  inspect_func = "cob_inspect_all";
5881  return NULL;
5882 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static cb_tree inspect_data
Definition: typeck.c:97
static const char * inspect_func
Definition: typeck.c:96
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_characters ( cb_tree  )

Definition at line 5863 of file typeck.c.

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

Referenced by yyparse().

5864 {
5865  if (inspect_data == NULL) {
5867  _("Data name expected before CHARACTERS"));
5868  }
5869  inspect_func = NULL;
5870  return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", inspect_data));
5871 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static cb_tree inspect_data
Definition: typeck.c:97
static const char * inspect_func
Definition: typeck.c:96
struct cb_statement * current_statement
Definition: parser.c:169
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_data ( cb_tree  )

Definition at line 5856 of file typeck.c.

References NULL.

Referenced by yyparse().

5857 {
5858  inspect_data = x;
5859  return NULL;
5860 }
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static cb_tree inspect_data
Definition: typeck.c:97

Here is the caller graph for this function:

cb_tree cb_build_tallying_leading ( void  )

Definition at line 5885 of file typeck.c.

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

Referenced by yyparse().

5886 {
5887  if (inspect_data == NULL) {
5889  _("Data name expected before LEADING"));
5890  }
5891  inspect_func = "cob_inspect_leading";
5892  return NULL;
5893 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static cb_tree inspect_data
Definition: typeck.c:97
static const char * inspect_func
Definition: typeck.c:96
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_trailing ( void  )

Definition at line 5896 of file typeck.c.

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

Referenced by yyparse().

5897 {
5898  if (inspect_data == NULL) {
5900  _("Data name expected before TRAILING"));
5901  }
5902  inspect_func = "cob_inspect_trailing";
5903  return NULL;
5904 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static cb_tree inspect_data
Definition: typeck.c:97
static const char * inspect_func
Definition: typeck.c:96
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_value ( cb_tree  ,
cb_tree   
)

Definition at line 5907 of file typeck.c.

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

Referenced by yyparse().

5908 {
5909  if (inspect_func == NULL) {
5910  cb_error_x (x, _("ALL, LEADING or TRAILING expected before '%s'"), cb_name (x));
5911  }
5913 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
char * cb_name(cb_tree x)
Definition: tree.c:735
#define _(s)
Definition: cobcrun.c:59
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static cb_tree inspect_data
Definition: typeck.c:97
static const char * inspect_func
Definition: typeck.c:96
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_unstring_delimited ( cb_tree  ,
cb_tree   
)

Definition at line 8578 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_error_node, and cb_validate_one().

Referenced by yyparse().

8579 {
8580  if (cb_validate_one (value)) {
8581  return cb_error_node;
8582  }
8583  return CB_BUILD_FUNCALL_2 ("cob_unstring_delimited", value, all);
8584 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
strict implicit external value
Definition: warning.def:54
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_error_node
Definition: tree.c:140

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_unstring_into ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 8587 of file typeck.c.

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

Referenced by yyparse().

8588 {
8589  if (cb_validate_one (name)) {
8590  return cb_error_node;
8591  }
8592  if (delimiter == NULL) {
8593  delimiter = cb_int0;
8594  }
8595  if (count == NULL) {
8596  count = cb_int0;
8597  }
8598  return CB_BUILD_FUNCALL_3 ("cob_unstring_into", name, delimiter, count);
8599 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int0
Definition: tree.c:133
cb_tree cb_error_node
Definition: tree.c:140

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_write_advancing_lines ( cb_tree  ,
cb_tree   
)

Definition at line 8685 of file typeck.c.

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.

Referenced by yyparse().

8686 {
8687  cb_tree e;
8688  int opt;
8689 
8690  opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8691  opt |= COB_WRITE_LINES;
8692  if (CB_LITERAL_P (lines)) {
8693  opt |= cb_get_int (lines);
8694  return cb_int_hex (opt);
8695  }
8696  e = cb_build_binary_op (cb_int (opt), '+', lines);
8697  return cb_build_cast_int (e);
8698 }
#define COB_WRITE_LINES
Definition: common.h:802
int cb_get_int(const cb_tree x)
Definition: tree.c:1101
#define COB_WRITE_AFTER
Definition: common.h:805
#define CB_LITERAL_P(x)
Definition: tree.h:602
cb_tree cb_int_hex(const int n)
Definition: tree.c:1514
#define CB_BEFORE
Definition: tree.h:25
cb_tree cb_int(const int n)
Definition: tree.c:1488
#define COB_WRITE_BEFORE
Definition: common.h:806
cb_tree cb_build_cast_int(const cb_tree val)
Definition: tree.c:2964
cb_tree cb_build_binary_op(cb_tree x, const int op, cb_tree y)
Definition: tree.c:2827

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_write_advancing_mnemonic ( cb_tree  ,
cb_tree   
)

Definition at line 8701 of file typeck.c.

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.

Referenced by yyparse().

8702 {
8703  int opt;
8704  int token;
8705 
8706  if (mnemonic == cb_error_node) {
8707  return cb_int0;
8708  }
8709  if (cb_ref (mnemonic) == cb_error_node) {
8710  return cb_int0;
8711  }
8712  token = CB_SYSTEM_NAME (cb_ref (mnemonic))->token;
8713  switch (token) {
8714  case CB_FEATURE_FORMFEED:
8715  opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8716  return cb_int_hex (opt | COB_WRITE_PAGE);
8717  case CB_FEATURE_C01:
8718  case CB_FEATURE_C02:
8719  case CB_FEATURE_C03:
8720  case CB_FEATURE_C04:
8721  case CB_FEATURE_C05:
8722  case CB_FEATURE_C06:
8723  case CB_FEATURE_C07:
8724  case CB_FEATURE_C08:
8725  case CB_FEATURE_C09:
8726  case CB_FEATURE_C10:
8727  case CB_FEATURE_C11:
8728  case CB_FEATURE_C12:
8729  opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8730  return cb_int_hex (opt | COB_WRITE_CHANNEL | COB_WRITE_PAGE | token);
8731  default:
8732  cb_error_x (mnemonic, _("Invalid mnemonic name"));
8733  return cb_int0;
8734  }
8735 }
#define CB_FEATURE_C01
Definition: tree.h:198
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_SYSTEM_NAME(x)
Definition: tree.h:586
#define CB_FEATURE_C07
Definition: tree.h:204
#define CB_FEATURE_C10
Definition: tree.h:207
#define CB_FEATURE_C09
Definition: tree.h:206
#define CB_FEATURE_FORMFEED
Definition: tree.h:196
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define COB_WRITE_AFTER
Definition: common.h:805
#define CB_FEATURE_C02
Definition: tree.h:199
#define COB_WRITE_PAGE
Definition: common.h:803
#define _(s)
Definition: cobcrun.c:59
#define CB_FEATURE_C11
Definition: tree.h:208
#define CB_FEATURE_C03
Definition: tree.h:200
cb_tree cb_int_hex(const int n)
Definition: tree.c:1514
#define COB_WRITE_CHANNEL
Definition: common.h:804
cb_tree cb_int0
Definition: tree.c:133
#define CB_BEFORE
Definition: tree.h:25
cb_tree cb_error_node
Definition: tree.c:140
#define COB_WRITE_BEFORE
Definition: common.h:806
#define CB_FEATURE_C04
Definition: tree.h:201
#define CB_FEATURE_C12
Definition: tree.h:209
int token
Definition: tree.h:583
#define CB_FEATURE_C05
Definition: tree.h:202
#define CB_FEATURE_C06
Definition: tree.h:203
#define CB_FEATURE_C08
Definition: tree.h:205

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_write_advancing_page ( cb_tree  )

Definition at line 8738 of file typeck.c.

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

Referenced by yyparse().

8739 {
8740  int opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
8741 
8742  return cb_int_hex (opt | COB_WRITE_PAGE);
8743 }
#define COB_WRITE_AFTER
Definition: common.h:805
#define COB_WRITE_PAGE
Definition: common.h:803
cb_tree cb_int_hex(const int n)
Definition: tree.c:1514
#define CB_BEFORE
Definition: tree.h:25
#define COB_WRITE_BEFORE
Definition: common.h:806

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_category_is_alpha ( cb_tree  )

Definition at line 843 of file tree.c.

References category_is_alphanumeric, and CB_TREE_CATEGORY.

Referenced by cb_emit_allocate(), and yyparse().

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

Here is the caller graph for this function:

void cb_check_field_debug ( cb_tree  )

Definition at line 904 of file typeck.c.

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, cb_field::name, NULL, and cb_field::size.

Referenced by yyparse().

905 {
906  cb_tree l;
907  cb_tree x;
908  cb_tree z;
909  size_t size;
910  size_t found;
911  char buff[COB_MINI_BUFF];
912 
913  /* Basic reference check */
914  if (CB_WORD_COUNT (fld) > 0) {
915  if (!CB_WORD_ITEMS (fld)) {
916  return;
917  }
918  z = CB_VALUE(CB_WORD_ITEMS (fld));
919  if (!CB_FIELD_P (z)) {
920  return;
921  }
922  x = cb_ref (fld);
923  if (x == cb_error_node) {
924  return;
925  }
926  } else {
927  return;
928  }
929 
930  found = 0;
931  /* Check if reference is being debugged */
932  for (l = current_program->debug_list; l; l = CB_CHAIN (l)) {
933  if (!CB_PURPOSE (l)) {
934  continue;
935  }
936  if (x == CB_PURPOSE (l)) {
937  if (CB_REFERENCE (fld)->flag_target ||
938  CB_REFERENCE (CB_VALUE (l))->flag_all_debug) {
939  found = 1;
940  }
941  break;
942  }
943  }
944  if (!found) {
945  return;
946  }
947 
948  found = 0;
949  /* Found it - check if it is already in the statement list */
950  for (l = current_statement->debug_nodups; l; l = CB_CHAIN (l)) {
951  if (CB_VALUE (l) == x) {
952  found = 1;
953  break;
954  }
955  }
956  if (found) {
957  return;
958  }
959 
960  /* Set up debug info */
961  strcpy (buff, CB_FIELD(x)->name);
962  size = strlen (buff);
963  for (l = CB_REFERENCE (fld)->chain; l; l = CB_REFERENCE (l)->chain) {
964  z = cb_ref (l);
965  if (z != cb_error_node) {
966  size += strlen (CB_FIELD (z)->name);
967  size += 4;
968  if (size >= sizeof(buff)) {
969  break;
970  }
971  strcat (buff, " OF ");
972  strcat (buff, CB_FIELD (z)->name);
973  }
974  }
983  found = 0;
984  CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs);
985  l = CB_REFERENCE (fld)->subs;
986  for (; l && found < 3; l = CB_CHAIN (l), ++found) {
987  switch (found) {
988  case 0:
991  cb_build_move (CB_VALUE (l),
992  cb_debug_sub_1));
993  break;
994  case 1:
997  cb_build_move (CB_VALUE (l),
998  cb_debug_sub_2));
999  break;
1000  case 2:
1003  cb_build_move (CB_VALUE (l),
1004  cb_debug_sub_3));
1005  break;
1006  default:
1007  break;
1008  }
1009  }
1010  CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs);
1011 
1012  for (; found < 3; ++found) {
1013  switch (found) {
1014  case 0:
1017  CB_BUILD_FUNCALL_3 ("memset",
1019  cb_int (' '),
1021  break;
1022  case 1:
1025  CB_BUILD_FUNCALL_3 ("memset",
1027  cb_int (' '),
1029  break;
1030  case 2:
1033  CB_BUILD_FUNCALL_3 ("memset",
1035  cb_int (' '),
1037  break;
1038  default:
1039  break;
1040  }
1041  }
1042 
1045  cb_build_debug_call (CB_FIELD(x)->debug_section));
1046 }
cb_tree cb_debug_sub_2
Definition: typeck.c:86
cb_tree debug_check
Definition: tree.h:1145
cb_tree cb_debug_name
Definition: typeck.c:84
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define COB_MINI_BUFF
Definition: common.h:539
#define CB_PURPOSE(x)
Definition: tree.h:1192
#define CB_WORD_ITEMS(x)
Definition: tree.h:906
cb_tree debug_list
Definition: tree.h:1264
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
#define CB_FIELD_P(x)
Definition: tree.h:741
#define CB_BUILD_CAST_ADDRESS(x)
Definition: tree.h:1841
cb_tree cb_debug_sub_1
Definition: typeck.c:85
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_build_debug_call(struct cb_label *target)
Definition: tree.c:1590
cb_tree cb_int(const int n)
Definition: tree.c:1488
cb_tree cb_error_node
Definition: tree.c:140
cb_tree cb_debug_sub_3
Definition: typeck.c:87
struct cb_program * current_program
Definition: parser.c:168
#define CB_WORD_COUNT(x)
Definition: tree.h:905
cb_tree cb_debug_contents
Definition: typeck.c:88
#define CB_BUILD_CAST_LENGTH(x)
Definition: tree.h:1843
cb_tree debug_nodups
Definition: tree.h:1146
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
cb_tree cb_list_reverse(cb_tree l)
Definition: tree.c:1327
struct cb_statement * current_statement
Definition: parser.c:169
#define CB_FIELD(x)
Definition: tree.h:740
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

size_t cb_check_index_p ( cb_tree  x)

Definition at line 887 of file typeck.c.

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

888 {
889  struct cb_field *f;
890 
891  if (!CB_REF_OR_FIELD_P (x)) {
892  return 0;
893  }
894  f = CB_FIELD_PTR (x);
895  if (f->usage == CB_USAGE_INDEX && !f->children) {
896  return 1;
897  }
898  return 0;
899 }
struct cb_field * children
Definition: tree.h:652
#define CB_FIELD_PTR(x)
Definition: tree.h:745
Definition: tree.h:643
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
enum cb_usage usage
Definition: tree.h:693
cb_tree cb_check_numeric_value ( cb_tree  )

Definition at line 651 of file typeck.c.

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

Referenced by cb_build_binary_op(), cb_emit_arithmetic(), and cb_emit_goto().

652 {
653  if (x == cb_error_node) {
654  return cb_error_node;
655  }
656 
658  return x;
659  }
660 
661  cb_error_x (x, _("'%s' is not a numeric value"), cb_name (x));
662  return cb_error_node;
663 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
char * cb_name(cb_tree x)
Definition: tree.c:735
#define _(s)
Definition: cobcrun.c:59
cb_tree cb_error_node
Definition: tree.c:140

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_clear_real_field ( void  )

Definition at line 1439 of file field.c.

References NULL.

Referenced by cb_build_program(), and yyparse().

1440 {
1442 }
static struct cb_field * last_real_field
Definition: field.c:41
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the caller graph for this function:

cb_tree cb_concat_literals ( const cb_tree  ,
const cb_tree   
)

Definition at line 1729 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

const char* cb_define ( cb_tree  ,
cb_tree   
)

Definition at line 1367 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_define_switch_name ( cb_tree  ,
cb_tree  ,
const int   
)

Definition at line 1228 of file typeck.c.

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.

Referenced by yyparse().

1229 {
1230  cb_tree switch_id;
1231  cb_tree value;
1232 
1233  if (!name || name == cb_error_node) {
1234  return NULL;
1235  }
1236  if (!sname || sname == cb_error_node ||
1237  CB_SYSTEM_NAME (sname)->category != CB_SWITCH_NAME) {
1238  cb_error_x (name, _("ON/OFF usage requires a SWITCH name"));
1239  return NULL;
1240  }
1241  switch_id = cb_int (CB_SYSTEM_NAME (sname)->token);
1242  value = CB_BUILD_FUNCALL_1 ("cob_get_switch", switch_id);
1243  if (flag == 0) {
1244  value = CB_BUILD_NEGATION (value);
1245  }
1246  cb_build_constant (name, value);
1247  return value;
1248 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_SYSTEM_NAME(x)
Definition: tree.h:586
cb_tree cb_build_constant(cb_tree name, cb_tree value)
Definition: tree.c:2189
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define CB_BUILD_NEGATION(x)
Definition: tree.h:1847
const char * name
Definition: tree.h:865
strict implicit external value
Definition: warning.def:54
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int(const int n)
Definition: tree.c:1488
cb_tree cb_error_node
Definition: tree.c:140

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept ( cb_tree  ,
cb_tree  ,
struct cb_attr_struct  
)

Definition at line 4341 of file typeck.c.

References _, cb_attr_struct::bgc, CB_BUILD_FUNCALL_1, CB_BUILD_FUNCALL_10, CB_BUILD_FUNCALL_4, 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_attr_struct::size_is, cb_field::storage, cb_attr_struct::timeout, and valid_screen_pos().

Referenced by yyparse().

4342 {
4343  cb_tree line;
4344  cb_tree column;
4345  cb_tree fgc;
4346  cb_tree bgc;
4347  cb_tree scroll;
4348  cb_tree timeout;
4349  cb_tree prompt;
4350  cb_tree size_is; /* WITH SIZE IS */
4351  int dispattrs;
4352 
4353  if (cb_validate_one (var)) {
4354  return;
4355  }
4356 
4357  if (attr_ptr) {
4358  fgc = attr_ptr->fgc;
4359  bgc = attr_ptr->bgc;
4360  scroll = attr_ptr->scroll;
4361  timeout = attr_ptr->timeout;
4362  prompt = attr_ptr->prompt;
4363  size_is = attr_ptr->size_is;
4364  dispattrs = attr_ptr->dispattrs;
4365  if (cb_validate_one (pos)) {
4366  return;
4367  }
4368  if (cb_validate_one (fgc)) {
4369  return;
4370  }
4371  if (cb_validate_one (bgc)) {
4372  return;
4373  }
4374  if (cb_validate_one (scroll)) {
4375  return;
4376  }
4377  if (cb_validate_one (timeout)) {
4378  return;
4379  }
4380  if (cb_validate_one (prompt)) {
4381  return;
4382  }
4383  if (cb_validate_one (size_is)) {
4384  return;
4385  }
4386  } else {
4387  fgc = NULL;
4388  bgc = NULL;
4389  scroll = NULL;
4390  timeout = NULL;
4391  prompt = NULL;
4392  size_is = NULL;
4393  dispattrs = 0;
4394  }
4395 
4396  if (prompt) {
4397  /* PROMPT character - 1 character identifier or literal */
4398  if (CB_LITERAL_P (prompt)) {
4399  if (CB_LITERAL (prompt)->size != 1) {
4400  cb_error_x (prompt, _("Invalid PROMPT literal"));
4401  return;
4402  }
4403  } else {
4404  if (CB_FIELD_PTR (prompt)->size != 1) {
4405  cb_error_x (prompt, _("Invalid PROMPT identifier"));
4406  return;
4407  }
4408  }
4409  }
4410 
4411 #if 0 /* RXWRXW - Screen */
4412  if ((CB_REF_OR_FIELD_P (var)) &&
4413  CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) {
4415  }
4416 #endif
4417 
4419  /* Bump ref count to force CRT STATUS field generation */
4420  if (current_program->crt_status) {
4422  }
4423  if ((CB_REF_OR_FIELD_P (var)) &&
4424  CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) {
4425  output_screen_from (CB_FIELD (cb_ref (var)), 0);
4426  gen_screen_ptr = 1;
4427  if (pos) {
4428  if (CB_LIST_P (pos)) {
4429  line = CB_PAIR_X (pos);
4430  column = CB_PAIR_Y (pos);
4431  cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
4432  var, line, column, timeout));
4433  } else if (valid_screen_pos (pos)) {
4434  cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
4435  var, pos, NULL, timeout));
4436  }
4437  } else {
4438  cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
4439  var, NULL, NULL, timeout));
4440  }
4441  gen_screen_ptr = 0;
4442  output_screen_to (CB_FIELD (cb_ref (var)), 0);
4443  } else {
4444  if (var == cb_null) {
4445  var = NULL;
4446  }
4447  if (pos || fgc || bgc || scroll || dispattrs) {
4448  cb_gen_field_accept (var, pos, fgc, bgc, scroll,
4449  timeout, prompt, size_is, dispattrs);
4450  } else {
4451  cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept",
4452  var, NULL, NULL, fgc, bgc,
4453  scroll, timeout, prompt,
4454  size_is, cb_int (dispattrs)));
4455  }
4456  }
4457  } else if (pos || fgc || bgc || scroll || dispattrs) {
4458  /* Bump ref count to force CRT STATUS field generation */
4459  if (current_program->crt_status) {
4461  }
4462  if (var == cb_null) {
4463  var = NULL;
4464  }
4465  cb_gen_field_accept (var, pos, fgc, bgc, scroll,
4466  timeout, prompt, size_is, dispattrs);
4467  } else {
4468  if (var == cb_null) {
4469  var = NULL;
4470  }
4471  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
4472  }
4473 }
#define CB_PAIR_X(x)
Definition: tree.h:1205
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static void output_screen_to(struct cb_field *p, const unsigned int sisters)
Definition: typeck.c:4222
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_PAIR_Y(x)
Definition: tree.h:1206
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
cb_tree crt_status
Definition: tree.h:1287
unsigned int flag_screen
Definition: tree.h:1309
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static int valid_screen_pos(cb_tree pos)
Definition: typeck.c:4289
static void output_screen_from(struct cb_field *p, const unsigned int sisters)
Definition: typeck.c:4199
cb_tree cb_int(const int n)
Definition: tree.c:1488
#define CB_BUILD_FUNCALL_10(f, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
Definition: tree.h:1835
unsigned int gen_screen_ptr
Definition: tree.c:146
static void cb_gen_field_accept(cb_tree var, cb_tree pos, cb_tree fgc, cb_tree bgc, cb_tree scroll, cb_tree timeout, cb_tree prompt, cb_tree size_is, int dispattrs)
Definition: typeck.c:4316
if fold fold static computed alternate extra correct stack on syntax debugging line
Definition: flag.def:90
#define CB_LIST_P(x)
Definition: tree.h:1190
struct cb_program * current_program
Definition: parser.c:168
cb_tree cb_null
Definition: tree.c:124
#define cb_emit(x)
Definition: typeck.c:75
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_arg_number ( cb_tree  )

Definition at line 4596 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4597 {
4598  if (cb_validate_one (var)) {
4599  return;
4600  }
4601  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_arg_number", var));
4602 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_arg_value ( cb_tree  )

Definition at line 4605 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4606 {
4607  if (cb_validate_one (var)) {
4608  return;
4609  }
4610  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_arg_value", var));
4611 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_command_line ( cb_tree  )

Definition at line 4566 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4567 {
4568  if (cb_validate_one (var)) {
4569  return;
4570  }
4571  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_command_line", var));
4572 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_date ( cb_tree  )

Definition at line 4512 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4513 {
4514  if (cb_validate_one (var)) {
4515  return;
4516  }
4517  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_date", var));
4518 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_date_yyyymmdd ( cb_tree  )

Definition at line 4521 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4522 {
4523  if (cb_validate_one (var)) {
4524  return;
4525  }
4526  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_date_yyyymmdd", var));
4527 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_day ( cb_tree  )

Definition at line 4530 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4531 {
4532  if (cb_validate_one (var)) {
4533  return;
4534  }
4535  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day", var));
4536 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_day_of_week ( cb_tree  )

Definition at line 4548 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4549 {
4550  if (cb_validate_one (var)) {
4551  return;
4552  }
4553  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day_of_week", var));
4554 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_day_yyyyddd ( cb_tree  )

Definition at line 4539 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4540 {
4541  if (cb_validate_one (var)) {
4542  return;
4543  }
4544  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day_yyyyddd", var));
4545 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_environment ( cb_tree  )

Definition at line 4587 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4588 {
4589  if (cb_validate_one (var)) {
4590  return;
4591  }
4592  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_environment", var));
4593 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_escape_key ( cb_tree  )

Definition at line 4485 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4486 {
4487  if (cb_validate_one (var)) {
4488  return;
4489  }
4490  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_escape_key", var));
4491 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_exception_status ( cb_tree  )

Definition at line 4494 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4495 {
4496  if (cb_validate_one (var)) {
4497  return;
4498  }
4499  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_exception_status", var));
4500 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_line_or_col ( cb_tree  ,
const int   
)

Definition at line 4476 of file typeck.c.

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

Referenced by yyparse().

4477 {
4478  if (cb_validate_one (var)) {
4479  return;
4480  }
4481  cb_emit (CB_BUILD_FUNCALL_2 ("cob_screen_line_col", var, cb_int (l_or_c)));
4482 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_int(const int n)
Definition: tree.c:1488
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_mnemonic ( cb_tree  ,
cb_tree   
)

Definition at line 4614 of file typeck.c.

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

Referenced by yyparse().

4615 {
4616  if (cb_validate_one (var)) {
4617  return;
4618  }
4619  if (cb_ref (mnemonic) == cb_error_node) {
4620  return;
4621  }
4622  switch (CB_SYSTEM_NAME (cb_ref (mnemonic))->token) {
4623  case CB_DEVICE_CONSOLE:
4624  case CB_DEVICE_SYSIN:
4625  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
4626  break;
4627  default:
4628  cb_error_x (mnemonic, _("Invalid input device '%s'"),
4629  cb_name (mnemonic));
4630  break;
4631  }
4632 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_SYSTEM_NAME(x)
Definition: tree.h:586
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
char * cb_name(cb_tree x)
Definition: tree.c:735
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define _(s)
Definition: cobcrun.c:59
#define CB_DEVICE_SYSIN
Definition: tree.h:153
cb_tree cb_error_node
Definition: tree.c:140
#define CB_DEVICE_CONSOLE
Definition: tree.h:156
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_name ( cb_tree  ,
cb_tree   
)

Definition at line 4635 of file typeck.c.

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

Referenced by yyparse().

4636 {
4637  cb_tree sys;
4638 
4639  if (cb_validate_one (var)) {
4640  return;
4641  }
4642 
4643  /* Allow direct reference to a device name */
4644  sys = lookup_system_name (CB_NAME (name));
4645  if (sys) {
4646  switch (CB_SYSTEM_NAME (sys)->token) {
4647  case CB_DEVICE_CONSOLE:
4648  case CB_DEVICE_SYSIN:
4649  if (!cb_relaxed_syntax_check) {
4650  cb_warning_x (name, _("'%s' is not defined in SPECIAL-NAMES"), CB_NAME (name));
4651  }
4652  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
4653  return;
4654  default:
4655  cb_error_x (name, _("Invalid input device '%s'"),
4656  cb_name (name));
4657  return;
4658  }
4659  }
4660 
4661  cb_error_x (name, _("'%s' is not defined in SPECIAL-NAMES"),
4662  CB_NAME (name));
4663 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_SYSTEM_NAME(x)
Definition: tree.h:586
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
char * cb_name(cb_tree x)
Definition: tree.c:735
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
const char * name
Definition: tree.h:865
#define _(s)
Definition: cobcrun.c:59
cb_tree lookup_system_name(const char *name)
Definition: reserved.c:2860
#define CB_DEVICE_SYSIN
Definition: tree.h:153
#define CB_NAME(x)
Definition: tree.h:904
#define CB_DEVICE_CONSOLE
Definition: tree.h:156
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_time ( cb_tree  )

Definition at line 4557 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4558 {
4559  if (cb_validate_one (var)) {
4560  return;
4561  }
4562  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_time", var));
4563 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_user_name ( cb_tree  )

Definition at line 4503 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

4504 {
4505  if (cb_validate_one (var)) {
4506  return;
4507  }
4508  cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_user_name", var));
4509 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_allocate ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 4668 of file typeck.c.

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.

Referenced by yyparse().

4670 {
4671  cb_tree x;
4672  char buff[32];
4673 
4674  if (cb_validate_one (target1)) {
4675  return;
4676  }
4677  if (cb_validate_one (target2)) {
4678  return;
4679  }
4680  if (cb_validate_one (size)) {
4681  return;
4682  }
4683  if (cb_validate_one (initialize)) {
4684  return;
4685  }
4686  if (target1) {
4687  if (!(CB_REFERENCE_P(target1) &&
4688  CB_FIELD_PTR (target1)->flag_item_based)) {
4690  _("Target of ALLOCATE is not a BASED item"));
4691  return;
4692  }
4693  }
4694  if (target2) {
4695  if (!(CB_REFERENCE_P(target2) &&
4696  CB_TREE_CLASS (target2) == CB_CLASS_POINTER)) {
4698  _("Target of RETURNING is not a data pointer"));
4699  return;
4700  }
4701  }
4702  if (size) {
4703  if (CB_TREE_CLASS (size) != CB_CLASS_NUMERIC) {
4705  _("The CHARACTERS field of ALLOCATE must be numeric"));
4706  return;
4707  }
4708  }
4709  if (target1) {
4710  sprintf (buff, "%d", CB_FIELD_PTR (target1)->memory_size);
4711  x = cb_build_numeric_literal (0, buff, 0);
4712  cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate",
4713  CB_BUILD_CAST_ADDR_OF_ADDR (target1),
4714  target2, x, NULL));
4715  } else {
4716  if (initialize && !cb_category_is_alpha (initialize)) {
4718  _("INITIALIZED TO item is not alphanumeric"));
4719  }
4720  cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate",
4721  NULL, target2, size, initialize));
4722  }
4723  if (initialize && target1) {
4725  cb_build_initialize (target1, cb_true, NULL, 1, 0, 0);
4726  }
4727 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_true
Definition: tree.c:122
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
#define CB_TREE_CLASS(x)
Definition: tree.h:442
cb_tree cb_build_numeric_literal(const int sign, const void *data, const int scale)
Definition: tree.c:1681
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_BUILD_CAST_ADDR_OF_ADDR(x)
Definition: tree.h:1842
cb_tree cb_build_initialize(const cb_tree var, const cb_tree val, const cb_tree rep, const unsigned int def, const unsigned int is_statement, const unsigned int no_filler_init)
Definition: tree.c:3028
int cb_category_is_alpha(cb_tree x)
Definition: tree.c:843
#define cb_emit(x)
Definition: typeck.c:75
struct cb_statement * current_statement
Definition: parser.c:169
cb_tree handler2
Definition: tree.h:1142

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_alter ( cb_tree  ,
cb_tree   
)

Definition at line 4733 of file typeck.c.

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

Referenced by yyparse().

4734 {
4735  if (source == cb_error_node) {
4736  return;
4737  }
4738  if (target == cb_error_node) {
4739  return;
4740  }
4741  CB_REFERENCE(source)->flag_alter_code = 1;
4742  cb_emit (cb_build_alter (source, target));
4743 }
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_error_node
Definition: tree.c:140
cb_tree cb_build_alter(const cb_tree source, const cb_tree target)
Definition: tree.c:3101
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_arg_number ( cb_tree  )

Definition at line 5124 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

5125 {
5126  if (cb_validate_one (value)) {
5127  return;
5128  }
5129  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_arg_number", value));
5130 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
strict implicit external value
Definition: warning.def:54
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_arithmetic ( cb_tree  ,
const int  ,
cb_tree   
)

Definition at line 3465 of file typeck.c.

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.

Referenced by yyparse().

3466 {
3467  cb_tree l;
3468  cb_tree x;
3469 
3470  x = cb_check_numeric_value (val);
3471 
3472  if (op) {
3474  } else {
3476  }
3477 
3478  if (cb_validate_one (x)) {
3479  return;
3480  }
3481  if (cb_validate_list (vars)) {
3482  return;
3483  }
3484 
3485  if (!CB_BINARY_OP_P (x)) {
3486  if (op == '+' || op == '-' || op == '*' || op == '/') {
3488  for (l = vars; l; l = CB_CHAIN (l)) {
3490  switch (op) {
3491  case '+':
3492  CB_VALUE (l) = cb_build_add (CB_VALUE (l), x, CB_PURPOSE (l));
3493  break;
3494  case '-':
3495  CB_VALUE (l) = cb_build_sub (CB_VALUE (l), x, CB_PURPOSE (l));
3496  break;
3497  case '*':
3498  CB_VALUE (l) = cb_build_mul (CB_VALUE (l), x, CB_PURPOSE (l));
3499  break;
3500  case '/':
3501  CB_VALUE (l) = cb_build_div (CB_VALUE (l), x, CB_PURPOSE (l));
3502  break;
3503  }
3504  }
3505  cb_emit_list (vars);
3506  return;
3507  }
3508  }
3509  if (x == cb_error_node) {
3510  return;
3511  }
3512 
3513  cb_emit_list (build_decimal_assign (vars, op, x));
3514 }
static cb_tree cb_check_numeric_edited_name(cb_tree x)
Definition: typeck.c:633
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_build_add(cb_tree v, cb_tree n, cb_tree round_opt)
Definition: typeck.c:4015
static cb_tree cb_build_mul(cb_tree v, cb_tree n, cb_tree round_opt)
Definition: typeck.c:3368
#define CB_PURPOSE(x)
Definition: tree.h:1192
cb_tree cb_build_sub(cb_tree v, cb_tree n, cb_tree round_opt)
Definition: typeck.c:4058
#define cb_emit_list(l)
Definition: typeck.c:77
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_BINARY_OP_P(x)
Definition: tree.h:937
static void cb_check_data_incompat(cb_tree x)
Definition: typeck.c:719
#define CB_CHAIN(x)
Definition: tree.h:1194
static cb_tree cb_build_div(cb_tree v, cb_tree n, cb_tree round_opt)
Definition: typeck.c:3390
cb_tree cb_error_node
Definition: tree.c:140
static cb_tree build_decimal_assign(cb_tree vars, const int op, cb_tree val)
Definition: typeck.c:3412
void cb_list_map(cb_tree(*func)(cb_tree x), cb_tree l)
Definition: tree.c:1357
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
cb_tree cb_check_numeric_value(cb_tree x)
Definition: typeck.c:651
static cb_tree cb_check_numeric_name(cb_tree x)
Definition: typeck.c:616

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_call ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 4748 of file typeck.c.

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, sign, system_table::syst_name, system_table::syst_params, value, and warningopt.

Referenced by yyparse().

4751 {
4752  cb_tree l;
4753  cb_tree x;
4754  struct cb_field *f;
4755  const struct system_table *psyst;
4756  const char *p;
4757  const char *entry;
4758  cob_s64_t val;
4759  cob_s64_t valmin;
4760  cob_s64_t valmax;
4761  cob_u32_t is_sys_call;
4762  cob_u32_t is_sys_idx;
4763  int error_ind;
4764  int call_conv;
4765  int numargs;
4766 
4767  if (CB_INTRINSIC_P (prog)) {
4768  if (CB_INTRINSIC(prog)->intr_tab->category != CB_CATEGORY_ALPHANUMERIC) {
4770  _("Only alphanumeric FUNCTION types are allowed here"));
4771  return;
4772  }
4773  }
4774  if (returning && returning != cb_null) {
4775  if (CB_TREE_CLASS(returning) != CB_CLASS_NUMERIC &&
4776  CB_TREE_CLASS(returning) != CB_CLASS_POINTER) {
4778  _("Invalid RETURNING field"));
4779  return;
4780  }
4781  }
4782 
4783  error_ind = 0;
4784  numargs = 0;
4785 
4786  if (convention) {
4787  if (CB_INTEGER_P (convention)) {
4788  call_conv = CB_INTEGER (convention)->val;
4789  } else {
4790  call_conv = cb_get_int (convention);
4791  }
4792  } else {
4793  call_conv = 0;
4794  }
4795 #ifndef _WIN32
4796  if (call_conv & CB_CONV_STDCALL) {
4797  call_conv &= ~CB_CONV_STDCALL;
4798  if (warningopt) {
4799  cb_warning (_("STDCALL not available on this platform"));
4800  }
4801  }
4802 #elif defined(_WIN64)
4803  if (call_conv & CB_CONV_STDCALL) {
4804  if (warningopt) {
4805  cb_warning (_("STDCALL used on 64-bit Windows platform"));
4806  }
4807  }
4808 #endif
4809  if ((call_conv & CB_CONV_STATIC_LINK) && !CB_LITERAL_P (prog)) {
4811  _("STATIC CALL convention requires a literal program name"));
4812  error_ind = 1;
4813  }
4814 
4815  for (l = par_using; l; l = CB_CHAIN (l), numargs++) {
4816  x = CB_VALUE (l);
4817  if (x == cb_error_node) {
4818  error_ind = 1;
4819  continue;
4820  }
4821  if (CB_NUMERIC_LITERAL_P (x)) {
4822  if (CB_PURPOSE_INT (l) != CB_CALL_BY_VALUE) {
4823  continue;
4824  }
4825  if (CB_SIZES_INT_UNSIGNED(l) &&
4826  CB_LITERAL (x)->sign < 0) {
4827  cb_error_x (x, _("Numeric literal is negative"));
4828  error_ind = 1;
4829  continue;
4830  }
4831  val = 0;
4832  valmin = 0;
4833  valmax = 0;
4834  switch (CB_SIZES_INT (l)) {
4835  case CB_SIZE_1:
4836  val = cb_get_long_long (x);
4837  if (CB_SIZES_INT_UNSIGNED(l)) {
4838  valmin = 0;
4839  valmax = UCHAR_MAX;
4840  } else {
4841  valmin = CHAR_MIN;
4842  valmax = CHAR_MAX;
4843  }
4844  break;
4845  case CB_SIZE_2:
4846  val = cb_get_long_long (x);
4847  if (CB_SIZES_INT_UNSIGNED(l)) {
4848  valmin = 0;
4849  valmax = USHRT_MAX;
4850  } else {
4851  valmin = SHRT_MIN;
4852  valmax = SHRT_MAX;
4853  }
4854  break;
4855  case CB_SIZE_4:
4856  val = cb_get_long_long (x);
4857  if (CB_SIZES_INT_UNSIGNED(l)) {
4858  valmin = 0;
4859  valmax = UINT_MAX;
4860  } else {
4861  valmin = INT_MIN;
4862  valmax = INT_MAX;
4863  }
4864  break;
4865  case CB_SIZE_8:
4866  case CB_SIZE_AUTO:
4867  if (CB_SIZES_INT_UNSIGNED(l)) {
4868  if (CB_LITERAL (x)->size < 20) {
4869  break;
4870  }
4871  if (CB_LITERAL (x)->size > 20) {
4872  valmin = 1;
4873  break;
4874  }
4875  if (memcmp (CB_LITERAL (x)->data,
4876  "18446744073709551615",
4877  (size_t)20) > 0) {
4878  valmin = 1;
4879  break;
4880  }
4881  } else {
4882  if (CB_LITERAL (x)->size < 19) {
4883  break;
4884  }
4885  if (CB_LITERAL (x)->size > 19) {
4886  valmin = 1;
4887  break;
4888  }
4889  if (memcmp (CB_LITERAL (x)->data,
4890  "9223372036854775807",
4891  (size_t)19) > 0) {
4892  valmin = 1;
4893  break;
4894  }
4895  }
4896  break;
4897  default:
4898  break;
4899  }
4900  if (!valmin && !valmax) {
4901  continue;
4902  }
4903  if (val < valmin || val > valmax) {
4904  cb_error_x (x, _("Numeric literal exceeds size limits"));
4905  error_ind = 1;
4906  }
4907  continue;
4908  }
4909  if (CB_CONST_P (x) && x != cb_null) {
4910  cb_error_x (x, _("Figurative constant invalid here"));
4911  error_ind = 1;
4912  continue;
4913  }
4914  if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) ||
4915  CB_FIELD_P (x)) {
4916  f = CB_FIELD_PTR (x);
4917  if (f->level == 88) {
4918  cb_error_x (x, _("'%s' is not a valid data name"), CB_NAME (x));
4919  error_ind = 1;
4920  continue;
4921  }
4922  if (f->flag_any_length &&
4924  cb_error_x (x, _("'%s' ANY LENGTH item not passed BY REFERENCE"), CB_NAME (x));
4925  error_ind = 1;
4926  continue;
4927  }
4928  if (cb_warn_call_params &&
4930  if (f->level != 01 && f->level != 77) {
4931  cb_warning_x (x, _("'%s' is not a 01 or 77 level item"), CB_NAME (x));
4932  }
4933  }
4934  }
4935  }
4936 
4937  is_sys_call = 0;
4938  if (CB_LITERAL_P(prog)) {
4939  entry = NULL;
4940  p = (const char *)CB_LITERAL(prog)->data;
4941  for (; *p; ++p) {
4942  if (*p == '/' || *p == '\\') {
4943  entry = p + 1;
4944  }
4945  }
4946  if (!entry) {
4947  entry = (const char *)CB_LITERAL(prog)->data;
4948  }
4949  is_sys_idx = 1;
4950  for (psyst = system_tab; psyst->syst_name; psyst++, is_sys_idx++) {
4951  if (!strcmp(entry, (const char *)psyst->syst_name)) {
4952  if (psyst->syst_params > cb_list_length (par_using)) {
4954  _("Wrong number of CALL parameters for '%s'"),
4955  (char *)psyst->syst_name);
4956  return;
4957  }
4958  is_sys_call = is_sys_idx;
4959  break;
4960  }
4961  }
4962  }
4963 
4964  if (error_ind) {
4965  return;
4966  }
4967  if (numargs > current_program->max_call_param) {
4968  current_program->max_call_param = numargs;
4969  }
4970  cb_emit (cb_build_call (prog, par_using, on_exception, not_on_exception,
4971  returning, is_sys_call, call_conv));
4972 }
#define CB_NUMERIC_LITERAL_P(x)
Definition: tree.h:603
#define CB_TREE(x)
Definition: tree.h:440
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_INTEGER(x)
Definition: tree.h:522
static const struct system_table system_tab[]
Definition: typeck.c:282
#define cob_u32_t
Definition: common.h:31
#define CB_CALL_BY_REFERENCE
Definition: tree.h:44
#define CB_CONST_P(x)
Definition: tree.h:477
unsigned int flag_any_length
Definition: tree.h:712
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
cb_tree cb_build_call(const cb_tree name, const cb_tree args, const cb_tree stmt1, const cb_tree stmt2, const cb_tree returning, const cob_u32_t is_system_call, const int convention)
Definition: tree.c:3067
#define CB_LITERAL(x)
Definition: tree.h:601
#define CB_INTRINSIC(x)
Definition: tree.h:1001
#define CB_FIELD_PTR(x)
Definition: tree.h:745
#define CB_CONV_STDCALL
Definition: tree.h:135
#define CB_SIZE_8
Definition: tree.h:52
int cb_get_int(const cb_tree x)
Definition: tree.c:1101
int warningopt
Definition: cobc.c:176
#define CB_PURPOSE_INT(x)
Definition: tree.h:1197
#define CB_SIZE_2
Definition: tree.h:50
int max_call_param
Definition: tree.h:1298
int level
Definition: tree.h:673
#define CB_SIZES_INT(x)
Definition: tree.h:1199
#define cob_s64_t
Definition: common.h:51
#define CB_SIZE_4
Definition: tree.h:51
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_TREE_CLASS(x)
Definition: tree.h:442
#define CB_SIZE_AUTO
Definition: tree.h:48
int cb_list_length(cb_tree l)
Definition: tree.c:1342
strict implicit external value
Definition: warning.def:54
#define CB_FIELD_P(x)
Definition: tree.h:741
#define CB_SIZE_1
Definition: tree.h:49
#define _(s)
Definition: cobcrun.c:59
const int syst_params
Definition: typeck.c:48
Definition: tree.h:643
#define CB_CALL_BY_VALUE
Definition: tree.h:46
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
if sign
Definition: flag.def:42
#define CB_NAME(x)
Definition: tree.h:904
#define CB_REFERENCE(x)
Definition: tree.h:901
#define CB_CONV_STATIC_LINK
Definition: tree.h:132
cb_tree cb_error_node
Definition: tree.c:140
#define CB_INTRINSIC_P(x)
Definition: tree.h:1002
struct cb_program * current_program
Definition: parser.c:168
cb_tree cb_null
Definition: tree.c:124
void cb_warning(const char *,...) COB_A_FORMAT12
Definition: error.c:87
#define CB_SIZES_INT_UNSIGNED(x)
Definition: tree.h:1200
const char * syst_name
Definition: codegen.c:66
#define cb_emit(x)
Definition: typeck.c:75
cob_s64_t cb_get_long_long(const cb_tree x)
Definition: tree.c:1175
#define CB_INTEGER_P(x)
Definition: tree.h:523
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_cancel ( cb_tree  )

Definition at line 4977 of file typeck.c.

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

Referenced by yyparse().

4978 {
4979  if (cb_validate_one (prog)) {
4980  return;
4981  }
4982  cb_emit (cb_build_cancel (prog));
4983 }
cb_tree cb_build_cancel(const cb_tree target)
Definition: tree.c:3088
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_close ( cb_tree  ,
cb_tree   
)

Definition at line 4988 of file typeck.c.

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.

Referenced by yyparse().

4989 {
4990  struct cb_file *f;
4991 
4992  if (file == cb_error_node) {
4993  return;
4994  }
4995  file = cb_ref (file);
4996  if (file == cb_error_node) {
4997  return;
4998  }
5000  f = CB_FILE (file);
5001 
5002  if (f->organization == COB_ORG_SORT) {
5004  _("%s not allowed on %s files"), "CLOSE", "SORT");
5005  }
5006 
5007  cb_emit (CB_BUILD_FUNCALL_4 ("cob_close", file,
5008  f->file_status, opt, cb_int0));
5009 
5010  /* Check for file debugging */
5017  }
5018 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_debug_name
Definition: typeck.c:84
const char * name
Definition: tree.h:820
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
cb_tree cb_space
Definition: tree.c:127
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
struct cb_label * debug_section
Definition: tree.h:839
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int0
Definition: tree.c:133
cb_tree cb_build_debug_call(struct cb_label *target)
Definition: tree.c:1590
cb_tree file
Definition: tree.h:1140
Definition: tree.h:818
cb_tree cb_error_node
Definition: tree.c:140
cb_tree file_status
Definition: tree.h:824
unsigned int flag_fl_debug
Definition: tree.h:854
struct cb_program * current_program
Definition: parser.c:168
int organization
Definition: tree.h:844
#define COB_ORG_SORT
Definition: common.h:746
cb_tree cb_debug_contents
Definition: typeck.c:88
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_command_line ( cb_tree  )

Definition at line 5133 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

5134 {
5135  if (cb_validate_one (value)) {
5136  return;
5137  }
5138  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_command_line", value));
5139 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
strict implicit external value
Definition: warning.def:54
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_commit ( void  )

Definition at line 5023 of file typeck.c.

References CB_BUILD_FUNCALL_0, and cb_emit.

Referenced by yyparse().

5024 {
5025  cb_emit (CB_BUILD_FUNCALL_0 ("cob_commit"));
5026 }
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define cb_emit(x)
Definition: typeck.c:75

Here is the caller graph for this function:

void cb_emit_continue ( void  )

Definition at line 5031 of file typeck.c.

References cb_build_continue(), and cb_emit.

Referenced by yyparse().

5032 {
5034 }
cb_tree cb_build_continue(void)
Definition: tree.c:3214
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_corresponding ( cb_tree(*)(cb_tree, cb_tree, cb_tree ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Referenced by yyparse().

Here is the caller graph for this function:

void cb_emit_delete ( cb_tree  )

Definition at line 5039 of file typeck.c.

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.

Referenced by yyparse().

5040 {
5041  struct cb_file *f;
5042 
5043  if (file == cb_error_node) {
5044  return;
5045  }
5046  file = cb_ref (file);
5047  if (file == cb_error_node) {
5048  return;
5049  }
5051  f = CB_FILE (file);
5052 
5053  if (f->organization == COB_ORG_SORT) {
5055  _("%s not allowed on %s files"), "DELETE", "SORT");
5056  return;
5057  } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
5059  _("%s not allowed on %s files"), "DELETE", "LINE SEQUENTIAL");
5060  return;
5061  }
5062 
5063  /* Check for file debugging */
5066  f->flag_fl_debug) {
5067  /* Gen callback after delete but before exception test */
5069  }
5070 
5071  cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete", file,
5072  f->file_status));
5073 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree file
Definition: tree.h:1140
Definition: tree.h:818
cb_tree cb_error_node
Definition: tree.c:140
cb_tree file_status
Definition: tree.h:824
unsigned int flag_fl_debug
Definition: tree.h:854
struct cb_program * current_program
Definition: parser.c:168
int organization
Definition: tree.h:844
#define COB_ORG_SORT
Definition: common.h:746
unsigned int flag_callback
Definition: tree.h:1152
#define COB_ORG_LINE_SEQUENTIAL
Definition: common.h:743
#define cb_emit(x)
Definition: typeck.c:75
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_delete_file ( cb_tree  )

Definition at line 5076 of file typeck.c.

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.

Referenced by yyparse().

5077 {
5078  if (file == cb_error_node) {
5079  return;
5080  }
5081  file = cb_ref (file);
5082  if (file == cb_error_node) {
5083  return;
5084  }
5085  if (CB_FILE (file)->organization == COB_ORG_SORT) {
5087  _("%s not allowed on %s files"), "DELETE FILE", "SORT");
5088  return;
5089  }
5090 
5091  /* Check for file debugging */
5095  /* Gen callback after delete but before exception test */
5097  }
5098 
5099  cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete_file", file,
5100  CB_FILE(file)->file_status));
5101 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_error_node
Definition: tree.c:140
cb_tree file_status
Definition: tree.h:824
unsigned int flag_fl_debug
Definition: tree.h:854
struct cb_program * current_program
Definition: parser.c:168
int organization
Definition: tree.h:844
#define COB_ORG_SORT
Definition: common.h:746
unsigned int flag_callback
Definition: tree.h:1152
#define cb_emit(x)
Definition: typeck.c:75
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_display ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
struct cb_attr_struct  
)

Definition at line 5236 of file typeck.c.

References _, CB_BUILD_FUNCALL_0, CB_BUILD_FUNCALL_3, CB_CHAIN, cb_emit, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_P, CB_FUNCALL, cb_list_length(), CB_LITERAL, CB_LITERAL_P, cb_low, cb_name(), cb_null, 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_VALUE, COB_SCREEN_BELL, COB_SCREEN_ERASE_EOL, COB_SCREEN_ERASE_EOS, COB_SCREEN_NO_DISP, emit_field_display(), emit_screen_display(), gen_screen_ptr, initialize_attrs(), output_screen_from(), validate_attrs(), and value.

Referenced by emit_default_device_display(), emit_default_screen_display(), and yyparse().

5238 {
5239  cb_tree l;
5240  cb_tree x;
5241  cb_tree p;
5242  cb_tree fgc;
5243  cb_tree bgc;
5244  cb_tree scroll;
5245  cb_tree size_is; /* WITH SIZE IS */
5246  int dispattrs;
5247 
5248  if (cb_validate_list (values)) {
5249  return;
5250  }
5251 
5252  initialize_attrs (attr_ptr, &fgc, &bgc, &scroll, &size_is, &dispattrs);
5253  if (validate_attrs (pos, fgc, bgc, scroll, size_is)) {
5254  return;
5255  }
5256 
5257  for (l = values; l; l = CB_CHAIN (l)) {
5258  x = CB_VALUE (l);
5259  if (x == cb_error_node) {
5260  return;
5261  }
5262 
5263  switch (CB_TREE_TAG (x)) {
5264  case CB_TAG_LITERAL:
5265  case CB_TAG_INTRINSIC:
5266  case CB_TAG_CONST:
5267  case CB_TAG_STRING:
5268  case CB_TAG_INTEGER:
5269  break;
5270  case CB_TAG_REFERENCE:
5271  if (!CB_FIELD_P(CB_REFERENCE(x)->value)) {
5272  cb_error_x (x, _("'%s' is an invalid type for DISPLAY operand"), cb_name (x));
5273  return;
5274  }
5275  break;
5276  default:
5277  cb_error_x (x, _("Invalid type for DISPLAY operand"));
5278  return;
5279  }
5280  }
5281  if (upon == cb_error_node
5282  || !values /* <- silence warnings */) {
5283  return;
5284  }
5285 
5286 
5287  x = CB_VALUE (values);
5288  if ((CB_REF_OR_FIELD_P (x)) &&
5289  CB_FIELD (cb_ref (x))->storage == CB_STORAGE_SCREEN) {
5290  output_screen_from (CB_FIELD (cb_ref (x)), 0);
5291  gen_screen_ptr = 1;
5292  emit_screen_display (x, pos);
5293  gen_screen_ptr = 0;
5294  } else if (pos || fgc || bgc || scroll || size_is || dispattrs || upon == cb_null) {
5295  for (l = values; l; l = CB_CHAIN (l)) {
5296  x = CB_VALUE (l);
5297  /* low-values position cursor, size does not matter */
5298  if (x == cb_low) {
5299  dispattrs |= COB_SCREEN_NO_DISP;
5300  }
5301  /* no WITH SIZE then SPACE clears to end of screen */
5302  if (!(size_is)) {
5303  if (x == cb_space) {
5304  dispattrs |= COB_SCREEN_ERASE_EOS;
5305  dispattrs |= COB_SCREEN_NO_DISP;
5306  } else if (x == cb_low) {
5307  dispattrs |= COB_SCREEN_NO_DISP;
5308  } else if (CB_LITERAL_P (x) && CB_LITERAL (x)->all &&
5309  CB_LITERAL (x)->size == 1) {
5310  if (CB_LITERAL (x)->data[0] == 1) {
5311  dispattrs |= COB_SCREEN_ERASE_EOL;
5312  dispattrs |= COB_SCREEN_NO_DISP;
5313  } else if (CB_LITERAL (x)->data[0] == 2) {
5314  cb_emit (CB_BUILD_FUNCALL_0 ("cob_sys_clear_screen"));
5315  return;
5316  } else if (CB_LITERAL (x)->data[0] == 7) {
5317  dispattrs |= COB_SCREEN_BELL;
5318  dispattrs |= COB_SCREEN_NO_DISP;
5319  }
5320  }
5321  }
5322  emit_field_display (x, pos, fgc, bgc, scroll, size_is, dispattrs);
5323  }
5324  } else {
5325  /* DISPLAY x ... [UPON device-name] */
5326  p = CB_BUILD_FUNCALL_3 ("cob_display", upon, no_adv, values);
5327  CB_FUNCALL(p)->varcnt = cb_list_length (values);
5328  CB_FUNCALL(p)->nolitcast = 1;
5329  cb_emit (p);
5330  for (l = values; l; l = CB_CHAIN (l)) {
5331  x = CB_VALUE (l);
5332  if (CB_FIELD_P (x)) {
5333  CB_FIELD (cb_ref (x))->count++;
5334  }
5335  }
5336  }
5337 }
static int validate_attrs(cb_tree pos, cb_tree fgc, cb_tree bgc, cb_tree scroll, cb_tree size_is)
Definition: typeck.c:5142
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define COB_SCREEN_BELL
Definition: common.h:900
#define CB_LITERAL(x)
Definition: tree.h:601
static void emit_field_display(const cb_tree x, const cb_tree pos, const cb_tree fgc, const cb_tree bgc, const cb_tree scroll, const cb_tree size_is, const int dispattrs)
Definition: typeck.c:5202
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
char * cb_name(cb_tree x)
Definition: tree.c:735
cb_tree cb_space
Definition: tree.c:127
#define CB_FUNCALL(x)
Definition: tree.h:951
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define CB_VALUE(x)
Definition: tree.h:1193
#define COB_SCREEN_ERASE_EOL
Definition: common.h:904
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
int cb_list_length(cb_tree l)
Definition: tree.c:1342
strict implicit external value
Definition: warning.def:54
#define CB_FIELD_P(x)
Definition: tree.h:741
#define _(s)
Definition: cobcrun.c:59
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define CB_CHAIN(x)
Definition: tree.h:1194
#define CB_TREE_TAG(x)
Definition: tree.h:441
#define CB_REFERENCE(x)
Definition: tree.h:901
static void output_screen_from(struct cb_field *p, const unsigned int sisters)
Definition: typeck.c:4199
cb_tree cb_error_node
Definition: tree.c:140
unsigned int gen_screen_ptr
Definition: tree.c:146
static void emit_screen_display(const cb_tree x, const cb_tree pos)
Definition: typeck.c:5192
#define COB_SCREEN_ERASE_EOS
Definition: common.h:905
cb_tree cb_null
Definition: tree.c:124
#define COB_SCREEN_NO_DISP
Definition: common.h:921
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
static void initialize_attrs(const struct cb_attr_struct *const attr_ptr, cb_tree *const fgc, cb_tree *const bgc, cb_tree *const scroll, cb_tree *const size_is, int *const dispattrs)
Definition: typeck.c:5152
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
cb_tree cb_low
Definition: tree.c:128
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_display_omitted ( cb_tree  ,
struct cb_attr_struct  
)

Definition at line 5217 of file typeck.c.

References initialize_attrs(), and validate_attrs().

Referenced by yyparse().

5218 {
5219  cb_tree fgc;
5220  cb_tree bgc;
5221  cb_tree scroll;
5222  cb_tree size_is; /* WITH SIZE IS */
5223  int dispattrs;
5224 
5225  initialize_attrs (attr_ptr, &fgc, &bgc, &scroll, &size_is, &dispattrs);
5226  if (validate_attrs (pos, fgc, bgc, scroll, size_is)) {
5227  return;
5228  }
5229 
5230  /* TODO: Implement */
5231  /* Should we create a distinct omitted_display function in screenio.c? */
5232  /* emit_field_display (NULL, pos, fgc, bgc, scroll, size_is, dispattrs); */
5233 }
static int validate_attrs(cb_tree pos, cb_tree fgc, cb_tree bgc, cb_tree scroll, cb_tree size_is)
Definition: typeck.c:5142
static void initialize_attrs(const struct cb_attr_struct *const attr_ptr, cb_tree *const fgc, cb_tree *const bgc, cb_tree *const scroll, cb_tree *const size_is, int *const dispattrs)
Definition: typeck.c:5152

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_divide ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5399 of file typeck.c.

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.

Referenced by yyparse().

5401 {
5402  if (cb_validate_one (dividend)) {
5403  return;
5404  }
5405  if (cb_validate_one (divisor)) {
5406  return;
5407  }
5408  CB_VALUE (quotient) = cb_check_numeric_edited_name (CB_VALUE (quotient));
5409  CB_VALUE (remainder) = cb_check_numeric_edited_name (CB_VALUE (remainder));
5410 
5411  if (cb_validate_one (CB_VALUE (quotient))) {
5412  return;
5413  }
5414  if (cb_validate_one (CB_VALUE (remainder))) {
5415  return;
5416  }
5417 
5418  cb_emit (CB_BUILD_FUNCALL_4 ("cob_div_quotient", dividend, divisor,
5419  CB_VALUE (quotient),
5420  build_store_option (CB_VALUE (quotient),
5421  CB_PURPOSE (quotient))));
5422  cb_emit (CB_BUILD_FUNCALL_2 ("cob_div_remainder", CB_VALUE (remainder),
5423  build_store_option (CB_VALUE (remainder),
5424  cb_int0)));
5425 }
static cb_tree cb_check_numeric_edited_name(cb_tree x)
Definition: typeck.c:633
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
#define CB_PURPOSE(x)
Definition: tree.h:1192
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree cb_int0
Definition: tree.c:133
static cb_tree build_store_option(cb_tree x, cb_tree round_opt)
Definition: typeck.c:3193
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_env_name ( cb_tree  )

Definition at line 5106 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

5107 {
5108  if (cb_validate_one (value)) {
5109  return;
5110  }
5111  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_environment", value));
5112 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
strict implicit external value
Definition: warning.def:54
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_env_value ( cb_tree  )

Definition at line 5115 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

5116 {
5117  if (cb_validate_one (value)) {
5118  return;
5119  }
5120  cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_env_value", value));
5121 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
strict implicit external value
Definition: warning.def:54
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_evaluate ( cb_tree  ,
cb_tree   
)

Definition at line 5571 of file typeck.c.

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

Referenced by yyparse().

5572 {
5573  cb_tree x;
5574  char sbuf[16];
5575 
5576  snprintf (sbuf, sizeof(sbuf), "goto %s%d;", CB_PREFIX_LABEL, cb_id);
5577  x = cb_build_direct (cobc_parse_strdup (sbuf), 0);
5578  build_evaluate (subject_list, case_list, x);
5579  snprintf (sbuf, sizeof(sbuf), "%s%d:;", CB_PREFIX_LABEL, cb_id);
5580  cb_emit (cb_build_comment ("End EVALUATE"));
5582  cb_id++;
5583 }
cb_tree cb_build_comment(const char *str)
Definition: tree.c:1540
#define CB_PREFIX_LABEL
Definition: tree.h:37
int cb_id
Definition: cobc.c:163
void * cobc_parse_strdup(const char *dupstr)
Definition: cobc.c:827
cb_tree cb_build_direct(const char *str, const unsigned int flagnl)
Definition: tree.c:1553
static void build_evaluate(cb_tree subject_list, cb_tree case_list, cb_tree labid)
Definition: typeck.c:5493
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_exit ( const unsigned  int)

Definition at line 5653 of file typeck.c.

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

Referenced by yyparse().

5654 {
5655  if (goback) {
5657  } else {
5659  }
5660 }
cb_tree cb_int1
Definition: tree.c:134
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_goto(const cb_tree target, const cb_tree depending)
Definition: tree.c:3118

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_free ( cb_tree  )

Definition at line 5588 of file typeck.c.

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.

Referenced by yyparse().

5589 {
5590  cb_tree l;
5591  struct cb_field *f;
5592  int i;
5593 
5594  if (cb_validate_list (vars)) {
5595  return;
5596  }
5597  for (l = vars, i = 1; l; l = CB_CHAIN (l), i++) {
5598  if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_POINTER) {
5599  if (CB_CAST_P (CB_VALUE (l))) {
5600  f = CB_FIELD_PTR (CB_CAST (CB_VALUE(l))->val);
5601  if (!f->flag_item_based) {
5603  _("Target %d of FREE is not a BASED data item"), i);
5604  }
5605  cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
5607  } else {
5608  cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
5610  }
5611  } else if (CB_REF_OR_FIELD_P (CB_VALUE (l))) {
5612  f = CB_FIELD_PTR (CB_VALUE (l));
5613  if (!f->flag_item_based) {
5615  _("Target %d of FREE is not a BASED data item"), i);
5616  }
5617  cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
5619  } else {
5621  _("Target %d of FREE must be a data pointer"), i);
5622  }
5623  }
5624 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_CAST_P(x)
Definition: tree.h:963
#define CB_FIELD_PTR(x)
Definition: tree.h:745
#define CB_CAST(x)
Definition: tree.h:962
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_TREE_CLASS(x)
Definition: tree.h:442
#define CB_BUILD_CAST_ADDRESS(x)
Definition: tree.h:1841
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_BUILD_CAST_ADDR_OF_ADDR(x)
Definition: tree.h:1842
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
struct cb_statement * current_statement
Definition: parser.c:169
unsigned int flag_item_based
Definition: tree.h:713

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_get_environment ( cb_tree  ,
cb_tree   
)

Definition at line 4575 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_emit, and cb_validate_one().

Referenced by yyparse().

4576 {
4577  if (cb_validate_one (envvar)) {
4578  return;
4579  }
4580  if (cb_validate_one (envval)) {
4581  return;
4582  }
4583  cb_emit (CB_BUILD_FUNCALL_2 ("cob_get_environment", envvar, envval));
4584 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_goto ( cb_tree  ,
cb_tree   
)

Definition at line 5629 of file typeck.c.

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.

Referenced by yyparse().

5630 {
5631  if (target == cb_error_node) {
5632  return;
5633  }
5634  if (target == NULL) {
5635  cb_verify (cb_goto_statement_without_name, _("GO TO without procedure-name"));
5636  } else if (depending) {
5637  /* GO TO procedure-name ... DEPENDING ON identifier */
5639  return;
5640  }
5642  cb_emit (cb_build_goto (target, depending));
5643  } else if (CB_CHAIN (target)) {
5645  _("GO TO with multiple procedure-names"));
5646  } else {
5647  /* GO TO procedure-name */
5648  cb_emit (cb_build_goto (CB_VALUE (target), NULL));
5649  }
5650 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
unsigned int cb_verify(const enum cb_support, const char *)
Definition: error.c:246
#define CB_VALUE(x)
Definition: tree.h:1193
cb_tree depending
Definition: tree.h:647
static void cb_check_data_incompat(cb_tree x)
Definition: typeck.c:719
#define _(s)
Definition: cobcrun.c:59
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_error_node
Definition: tree.c:140
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_check_numeric_value(cb_tree x)
Definition: typeck.c:651
struct cb_statement * current_statement
Definition: parser.c:169
cb_tree cb_build_goto(const cb_tree target, const cb_tree depending)
Definition: tree.c:3118

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_if ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5665 of file typeck.c.

References cb_build_if(), and cb_emit.

Referenced by yyparse().

5666 {
5667  cb_emit (cb_build_if (cond, stmt1, stmt2, 1));
5668 }
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_if(const cb_tree test, const cb_tree stmt1, const cb_tree stmt2, const unsigned int is_if)
Definition: tree.c:3132

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_initialize ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 5682 of file typeck.c.

References _, cb_build_initialize(), CB_CHAIN, cb_emit, cb_error_x(), CB_FIELD_P, CB_REFERENCE, CB_REFERENCE_P, CB_TREE, cb_true, cb_validate_list(), CB_VALUE, current_statement, and NULL.

Referenced by yyparse().

5684 {
5685  cb_tree l;
5686  unsigned int no_fill_init;
5687  unsigned int def_init;
5688  cb_tree x;
5689 
5690  if (cb_validate_list (vars)) {
5691  return;
5692  }
5693  if (value == NULL && replacing == NULL) {
5694  def = cb_true;
5695  }
5696  no_fill_init = (fillinit == NULL);
5697  def_init = (def != NULL);
5698  for (l = vars; l; l = CB_CHAIN (l)) {
5699  x = CB_VALUE (l);
5700  if (!(CB_REFERENCE_P (x) && CB_FIELD_P (CB_REFERENCE (x)->value)) &&
5701  !CB_FIELD_P (x)) {
5702  cb_error_x (CB_TREE (current_statement), _("Invalid INITIALIZE statement"));
5703  return;
5704  }
5705 
5706  cb_emit (cb_build_initialize (x , value, replacing,
5707  def_init, 1, no_fill_init));
5708  }
5709 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_true
Definition: tree.c:122
#define CB_VALUE(x)
Definition: tree.h:1193
strict implicit external value
Definition: warning.def:54
#define CB_FIELD_P(x)
Definition: tree.h:741
#define _(s)
Definition: cobcrun.c:59
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_build_initialize(const cb_tree var, const cb_tree val, const cb_tree rep, const unsigned int def, const unsigned int is_statement, const unsigned int no_filler_init)
Definition: tree.c:3028
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_inspect ( cb_tree  ,
cb_tree  ,
cb_tree  ,
const unsigned  int 
)

Definition at line 5805 of file typeck.c.

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.

Referenced by yyparse().

5807 {
5808  switch (CB_TREE_TAG(var)) {
5809  case CB_TAG_REFERENCE:
5810  break;
5811  case CB_TAG_INTRINSIC:
5812  if (replconv) {
5813  goto rep_error;
5814  }
5815  switch (CB_TREE_CATEGORY(var)) {
5818  case CB_CATEGORY_NATIONAL:
5819  break;
5820  default:
5822  _("Invalid target for %s"), "CONVERTING");
5823  return;
5824  }
5825  break;
5826  case CB_TAG_LITERAL:
5827  if (replconv) {
5828  goto rep_error;
5829  }
5830  break;
5831  default:
5832  goto rep_error;
5833  }
5834  cb_emit (CB_BUILD_FUNCALL_2 ("cob_inspect_init", var, replacing));
5835  cb_emit_list (body);
5836  cb_emit (CB_BUILD_FUNCALL_0 ("cob_inspect_finish"));
5837  return;
5838 rep_error:
5839  if (replconv == 1) {
5841  _("Invalid target for %s"), "REPLACING");
5842  } else {
5844  _("Invalid target for %s"), "CONVERTING");
5845  }
5846 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
#define cb_emit_list(l)
Definition: typeck.c:77
#define _(s)
Definition: cobcrun.c:59
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define CB_TREE_TAG(x)
Definition: tree.h:441
#define cb_emit(x)
Definition: typeck.c:75
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_move ( cb_tree  ,
cb_tree   
)

Definition at line 7416 of file typeck.c.

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.

Referenced by yyparse().

7417 {
7418  cb_tree l;
7419  cb_tree x;
7420  cb_tree m;
7421  unsigned int tempval;
7422 
7423  if (cb_validate_one (src)) {
7424  return;
7425  }
7426  if (cb_validate_list (dsts)) {
7427  return;
7428  }
7429 
7430  cb_check_data_incompat (src);
7431 
7432  tempval = 0;
7433  if (cb_list_length (dsts) > 1) {
7434  if (CB_INTRINSIC_P (src) || (CB_REFERENCE_P (src) &&
7435  (CB_REFERENCE (src)->subs || CB_REFERENCE (src)->offset))) {
7436  tempval = 1;
7437  cb_emit (CB_BUILD_FUNCALL_1 ("cob_put_indirect_field",
7438  src));
7439  }
7440  }
7441 
7442  for (l = dsts; l; l = CB_CHAIN (l)) {
7443  x = CB_VALUE (l);
7444  if (CB_LITERAL_P (x) || CB_CONST_P (x)) {
7446  _("Invalid MOVE target - %s"), cb_name (x));
7447  continue;
7448  }
7449  if (!tempval) {
7450  m = cb_build_move (src, x);
7451  } else {
7452  m = CB_BUILD_FUNCALL_1 ("cob_get_indirect_field", x);
7453  }
7454  cb_emit (m);
7455  }
7456 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_CONST_P(x)
Definition: tree.h:477
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
char * cb_name(cb_tree x)
Definition: tree.c:735
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define CB_VALUE(x)
Definition: tree.h:1193
int cb_list_length(cb_tree l)
Definition: tree.c:1342
int offset
Definition: tree.h:675
static void cb_check_data_incompat(cb_tree x)
Definition: typeck.c:719
#define _(s)
Definition: cobcrun.c:59
#define CB_CHAIN(x)
Definition: tree.h:1194
#define CB_REFERENCE(x)
Definition: tree.h:901
#define CB_INTRINSIC_P(x)
Definition: tree.h:1002
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_move_corresponding ( cb_tree  ,
cb_tree   
)

Definition at line 4175 of file typeck.c.

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

Referenced by yyparse().

4176 {
4177  cb_tree l;
4178  cb_tree v;
4179 
4180  x1 = cb_check_group_name (x1);
4181  if (cb_validate_one (x1)) {
4182  return;
4183  }
4184  for (l = x2; l; l = CB_CHAIN(l)) {
4185  v = CB_VALUE(l);
4186  v = cb_check_group_name (v);
4187  if (cb_validate_one (v)) {
4188  return;
4189  }
4190  if (!emit_move_corresponding (x1, v)) {
4191  if (cb_warn_corresponding) {
4192  cb_warning_x (v, _("No CORRESPONDING items found"));
4193  }
4194  }
4195  }
4196 }
static cb_tree cb_check_group_name(cb_tree x)
Definition: typeck.c:592
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
static unsigned int emit_move_corresponding(cb_tree x1, cb_tree x2)
Definition: typeck.c:4145
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_VALUE(x)
Definition: tree.h:1193
#define _(s)
Definition: cobcrun.c:59
#define CB_CHAIN(x)
Definition: tree.h:1194

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_open ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 7461 of file typeck.c.

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.

Referenced by yyparse().

7462 {
7463  struct cb_file *f;
7464 
7465  if (file == cb_error_node) {
7466  return;
7467  }
7468  file = cb_ref (file);
7469  if (file == cb_error_node) {
7470  return;
7471  }
7473  f = CB_FILE (file);
7474 
7475  if (f->organization == COB_ORG_SORT) {
7477  _("%s not allowed on %s files"), "OPEN", "SORT");
7478  return;
7479  } else if (f->organization == COB_ORG_LINE_SEQUENTIAL &&
7480  mode == cb_int (COB_OPEN_I_O)) {
7482  _("%s not allowed on %s files"), "OPEN I-O", "LINE SEQUENTIAL");
7483  return;
7484  }
7485  if (sharing == NULL) {
7486  if (f->sharing) {
7487  sharing = f->sharing;
7488  } else {
7489  sharing = cb_int0;
7490  }
7491  }
7492 
7493  cb_emit (CB_BUILD_FUNCALL_4 ("cob_open", file, mode,
7494  sharing, f->file_status));
7495 
7496  /* Check for file debugging */
7499  f->flag_fl_debug) {
7503  }
7504 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_debug_name
Definition: typeck.c:84
const char * name
Definition: tree.h:820
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
cb_tree cb_space
Definition: tree.c:127
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
struct cb_label * debug_section
Definition: tree.h:839
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int0
Definition: tree.c:133
cb_tree cb_build_debug_call(struct cb_label *target)
Definition: tree.c:1590
cb_tree cb_int(const int n)
Definition: tree.c:1488
cb_tree file
Definition: tree.h:1140
cb_tree sharing
Definition: tree.h:825
Definition: tree.h:818
cb_tree cb_error_node
Definition: tree.c:140
#define COB_OPEN_I_O
Definition: common.h:786
cb_tree file_status
Definition: tree.h:824
unsigned int flag_fl_debug
Definition: tree.h:854
struct cb_program * current_program
Definition: parser.c:168
int organization
Definition: tree.h:844
#define COB_ORG_SORT
Definition: common.h:746
cb_tree cb_debug_contents
Definition: typeck.c:88
#define COB_ORG_LINE_SEQUENTIAL
Definition: common.h:743
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_perform ( cb_tree  ,
cb_tree   
)

Definition at line 7509 of file typeck.c.

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.

Referenced by yyparse().

7510 {
7511  if (perform == cb_error_node) {
7512  return;
7513  }
7516  cb_emit (cb_build_debug (cb_debug_contents, "PERFORM LOOP", NULL));
7517  }
7518  CB_PERFORM (perform)->body = body;
7519  cb_emit (perform);
7520 }
#define CB_PAIR_P(x)
Definition: tree.h:1204
unsigned int flag_debugging
Definition: tree.h:1320
#define CB_PERFORM(x)
Definition: tree.h:1118
unsigned int flag_in_debug
Definition: tree.h:1150
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_error_node
Definition: tree.c:140
struct cb_program * current_program
Definition: parser.c:168
cb_tree cb_debug_contents
Definition: typeck.c:88
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_read ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 7586 of file typeck.c.

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_EC_I_O_AT_END, 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.

Referenced by yyparse().

7588 {
7589  cb_tree file;
7590  cb_tree rec;
7591  cb_tree x;
7592  struct cb_file *f;
7593  int read_opts;
7594 
7595  read_opts = 0;
7596  if (lock_opts == cb_int1) {
7597  read_opts = COB_READ_LOCK;
7598  } else if (lock_opts == cb_int2) {
7599  read_opts = COB_READ_NO_LOCK;
7600  } else if (lock_opts == cb_int3) {
7601  read_opts = COB_READ_IGNORE_LOCK;
7602  } else if (lock_opts == cb_int4) {
7603  read_opts = COB_READ_WAIT_LOCK;
7604  }
7605  if (ref == cb_error_node) {
7606  return;
7607  }
7608  file = cb_ref (ref);
7609  if (file == cb_error_node) {
7610  return;
7611  }
7612  f = CB_FILE (file);
7613 
7614  rec = cb_build_field_reference (f->record, ref);
7615  if (f->organization == COB_ORG_SORT) {
7617  _("%s not allowed on %s files"), "READ", "SORT");
7618  return;
7619  }
7620  if (next == cb_int1 || next == cb_int2 ||
7622  /* READ NEXT/PREVIOUS */
7623  if (next == cb_int2) {
7624  switch (f->organization) {
7625  case COB_ORG_INDEXED:
7626  case COB_ORG_RELATIVE:
7627  break;
7628  default:
7630  _("READ PREVIOUS not allowed for this file type"));
7631  return;
7632  }
7633  read_opts |= COB_READ_PREVIOUS;
7634  } else {
7635  read_opts |= COB_READ_NEXT;
7636  }
7637  if (key) {
7638  cb_warning (_("KEY ignored with sequential READ"));
7639  }
7640  cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
7641  f->file_status,
7642  cb_int (read_opts)));
7643  } else {
7644  /* READ */
7645  /* DYNAMIC with [NOT] AT END */
7646  if (f->access_mode == COB_ACCESS_DYNAMIC &&
7648  read_opts |= COB_READ_NEXT;
7649  cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
7650  f->file_status,
7651  cb_int (read_opts)));
7652  } else if (key || f->key) {
7653  cb_emit (CB_BUILD_FUNCALL_4 ("cob_read",
7654  file, key ? key : f->key,
7655  f->file_status, cb_int (read_opts)));
7656  } else {
7657  cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
7658  f->file_status,
7659  cb_int (read_opts)));
7660  }
7661  }
7662  if (into) {
7663  current_statement->handler3 = cb_build_move (rec, into);
7664  }
7665 
7666  /* Check for file debugging */
7669  f->flag_fl_debug) {
7670  if (into) {
7673  }
7677  x = cb_build_move (rec, cb_debug_contents);
7683  }
7685 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_int1
Definition: tree.c:134
cb_tree cb_debug_name
Definition: typeck.c:84
const char * name
Definition: tree.h:820
#define COB_READ_NO_LOCK
Definition: common.h:818
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
cb_tree cb_build_field_reference(struct cb_field *f, cb_tree ref)
Definition: tree.c:2604
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define COB_ORG_INDEXED
Definition: common.h:745
int handler_id
Definition: tree.h:1148
#define COB_READ_PREVIOUS
Definition: common.h:814
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
struct cb_label * debug_section
Definition: tree.h:839
#define COB_ACCESS_DYNAMIC
Definition: common.h:752
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
#define COB_READ_WAIT_LOCK
Definition: common.h:820
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int4
Definition: tree.c:137
#define COB_ORG_RELATIVE
Definition: common.h:744
cb_tree cb_int3
Definition: tree.c:136
cb_tree cb_build_debug_call(struct cb_label *target)
Definition: tree.c:1590
cb_tree cb_int(const int n)
Definition: tree.c:1488
cb_tree file
Definition: tree.h:1140
#define COB_ACCESS_SEQUENTIAL
Definition: common.h:751
Definition: tree.h:818
#define COB_READ_IGNORE_LOCK
Definition: common.h:821
cb_tree cb_error_node
Definition: tree.c:140
int access_mode
Definition: tree.h:845
cb_tree file_status
Definition: tree.h:824
unsigned int flag_fl_debug
Definition: tree.h:854
struct cb_program * current_program
Definition: parser.c:168
struct cb_field * record
Definition: tree.h:829
int organization
Definition: tree.h:844
void cb_warning(const char *,...) COB_A_FORMAT12
Definition: error.c:87
#define CB_LIST_INIT(x)
Definition: tree.h:1851
#define COB_ORG_SORT
Definition: common.h:746
cb_tree cb_debug_contents
Definition: typeck.c:88
cb_tree handler3
Definition: tree.h:1143
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
#define COB_READ_NEXT
Definition: common.h:813
cb_tree key
Definition: tree.h:826
struct cb_statement * current_statement
Definition: parser.c:169
cb_tree cb_int2
Definition: tree.c:135
#define COB_READ_LOCK
Definition: common.h:817
cb_tree cb_list_add(cb_tree l, cb_tree x)
Definition: tree.c:1315

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_ready_trace ( void  )

Definition at line 7690 of file typeck.c.

References CB_BUILD_FUNCALL_0, and cb_emit.

Referenced by yyparse().

7691 {
7692  cb_emit (CB_BUILD_FUNCALL_0 ("cob_ready_trace"));
7693 }
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define cb_emit(x)
Definition: typeck.c:75

Here is the caller graph for this function:

void cb_emit_release ( cb_tree  ,
cb_tree   
)

Definition at line 7780 of file typeck.c.

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.

Referenced by yyparse().

7781 {
7782  struct cb_field *f;
7783  cb_tree file;
7784 
7785  if (cb_validate_one (record)) {
7786  return;
7787  }
7788  if (cb_validate_one (from)) {
7789  return;
7790  }
7791  if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
7793  _("%s requires a record name as subject"), "RELEASE");
7794  return;
7795  }
7796  f = CB_FIELD_PTR (record);
7797  if (f->storage != CB_STORAGE_FILE) {
7799  _("%s subject does not refer to a record name"), "RELEASE");
7800  return;
7801  }
7802  file = CB_TREE (f->file);
7803  if (CB_FILE (file)->organization != COB_ORG_SORT) {
7805  _("RELEASE not allowed on this record item"));
7806  return;
7807  }
7809  if (from) {
7810  cb_emit (cb_build_move (from, record));
7811  }
7812  cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_release", file));
7813 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
struct cb_file * file
Definition: tree.h:657
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
cb_tree file
Definition: tree.h:1140
#define COB_ORG_SORT
Definition: common.h:746
#define cb_emit(x)
Definition: typeck.c:75
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
struct cb_statement * current_statement
Definition: parser.c:169
enum cb_storage storage
Definition: tree.h:692

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_reset_trace ( void  )

Definition at line 7699 of file typeck.c.

References CB_BUILD_FUNCALL_0, and cb_emit.

Referenced by yyparse().

7700 {
7701  cb_emit (CB_BUILD_FUNCALL_0 ("cob_reset_trace"));
7702 }
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define cb_emit(x)
Definition: typeck.c:75

Here is the caller graph for this function:

void cb_emit_return ( cb_tree  ,
cb_tree   
)

Definition at line 7818 of file typeck.c.

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.

Referenced by yyparse().

7819 {
7820  cb_tree file;
7821  cb_tree rec;
7822 
7823  if (cb_validate_one (ref)) {
7824  return;
7825  }
7826  if (cb_validate_one (into)) {
7827  return;
7828  }
7829  file = cb_ref (ref);
7830  if (file == cb_error_node) {
7831  return;
7832  }
7833  rec = cb_build_field_reference (CB_FILE (file)->record, ref);
7834  cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_return", file));
7835  if (into) {
7836  current_statement->handler3 = cb_build_move (rec, into);
7837  }
7839 }
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_build_field_reference(struct cb_field *f, cb_tree ref)
Definition: tree.c:2604
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
cb_tree file
Definition: tree.h:1140
cb_tree cb_error_node
Definition: tree.c:140
cb_tree handler3
Definition: tree.h:1143
#define cb_emit(x)
Definition: typeck.c:75
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_rewrite ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 7707 of file typeck.c.

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.

Referenced by yyparse().

7708 {
7709  cb_tree file;
7710  struct cb_file *f;
7711  int opts;
7712 
7713  if (cb_validate_one (record)) {
7714  return;
7715  }
7716  if (cb_validate_one (from)) {
7717  return;
7718  }
7719  if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
7721  _("%s requires a record name as subject"), "REWRITE");
7722  return;
7723  }
7724  if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) {
7726  _("%s subject does not refer to a record name"), "REWRITE");
7727  return;
7728  }
7729 
7730  file = CB_TREE (CB_FIELD (cb_ref (record))->file);
7731  if (!file || file == cb_error_node) {
7732  return;
7733  }
7735  f = CB_FILE (file);
7736  opts = 0;
7737 
7738  if (f->organization == COB_ORG_SORT) {
7740  _("%s not allowed on %s files"), "REWRITE", "SORT");
7741  return;
7742  } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
7744  _("%s not allowed on %s files"), "REWRITE", "LINE SEQUENTIAL");
7745  return;
7747  (f->organization != COB_ORG_RELATIVE &&
7748  f->organization != COB_ORG_INDEXED)) {
7750  _("INVALID KEY clause invalid with this file type"));
7751  return;
7752  } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && lockopt) {
7754  _("LOCK clause invalid with file LOCK AUTOMATIC"));
7755  return;
7756  } else if (lockopt == cb_int1) {
7757  opts = COB_WRITE_LOCK;
7758  }
7759 
7760  if (from) {
7761  cb_emit (cb_build_move (from, record));
7762  }
7763 
7764  /* Check debugging on record name */
7767  CB_FIELD_PTR (record)->flag_field_debug) {
7769  CB_FIELD_PTR (record)->name, NULL));
7772  }
7773  cb_emit (CB_BUILD_FUNCALL_4 ("cob_rewrite", file, record,
7774  cb_int (opts), f->file_status));
7775 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_int1
Definition: tree.c:134
cb_tree cb_debug_name
Definition: typeck.c:84
const char * name
Definition: tree.h:820
#define COB_LOCK_AUTOMATIC
Definition: common.h:775
int lock_mode
Definition: tree.h:846
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define COB_ORG_INDEXED
Definition: common.h:745
int handler_id
Definition: tree.h:1148
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
struct cb_label * debug_section
Definition: tree.h:839
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define COB_ORG_RELATIVE
Definition: common.h:744
cb_tree cb_build_debug_call(struct cb_label *target)
Definition: tree.c:1590
cb_tree cb_int(const int n)
Definition: tree.c:1488
cb_tree file
Definition: tree.h:1140
Definition: tree.h:818
cb_tree cb_error_node
Definition: tree.c:140
cb_tree file_status
Definition: tree.h:824
struct cb_program * current_program
Definition: parser.c:168
struct cb_field * record
Definition: tree.h:829
int organization
Definition: tree.h:844
#define COB_ORG_SORT
Definition: common.h:746
cb_tree cb_debug_contents
Definition: typeck.c:88
#define COB_ORG_LINE_SEQUENTIAL
Definition: common.h:743
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
#define COB_WRITE_LOCK
Definition: common.h:808
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
struct cb_statement * current_statement
Definition: parser.c:169
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_rollback ( void  )

Definition at line 7844 of file typeck.c.

References CB_BUILD_FUNCALL_0, and cb_emit.

Referenced by yyparse().

7845 {
7846  cb_emit (CB_BUILD_FUNCALL_0 ("cob_rollback"));
7847 }
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define cb_emit(x)
Definition: typeck.c:75

Here is the caller graph for this function:

void cb_emit_search ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 7965 of file typeck.c.

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

Referenced by yyparse().

7966 {
7967  if (cb_validate_one (table)) {
7968  return;
7969  }
7970  if (cb_validate_one (varying)) {
7971  return;
7972  }
7973  if (table == cb_error_node) {
7974  return;
7975  }
7976  if (whens == cb_error_node) {
7977  return;
7978  }
7979  whens = cb_list_reverse (whens);
7980  cb_emit (cb_build_search (0, table, varying,
7981  cb_check_needs_break (at_end), whens));
7982 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_build_search(const int flag_all, const cb_tree table, const cb_tree var, const cb_tree end_stmt, const cb_tree whens)
Definition: tree.c:3049
static cb_tree cb_check_needs_break(cb_tree stmt)
Definition: typeck.c:523
cb_tree cb_error_node
Definition: tree.c:140
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_list_reverse(cb_tree l)
Definition: tree.c:1327

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_search_all ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 7985 of file typeck.c.

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.

Referenced by yyparse().

7986 {
7987  cb_tree x;
7988  cb_tree stmt_lis;
7989 
7990  if (cb_validate_one (table)) {
7991  return;
7992  }
7993  if (table == cb_error_node) {
7994  return;
7995  }
7996  if (when == cb_error_node) {
7997  return;
7998  }
7999  x = cb_build_search_all (table, when);
8000  if (!x) {
8001  return;
8002  }
8003 
8004  stmt_lis = cb_check_needs_break (stmts);
8005  cb_emit (cb_build_search (1, table, NULL,
8006  cb_check_needs_break (at_end),
8007  cb_build_if (x, stmt_lis, NULL, 0)));
8008 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_build_search(const int flag_all, const cb_tree table, const cb_tree var, const cb_tree end_stmt, const cb_tree whens)
Definition: tree.c:3049
static cb_tree cb_check_needs_break(cb_tree stmt)
Definition: typeck.c:523
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_error_node
Definition: tree.c:140
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_if(const cb_tree test, const cb_tree stmt1, const cb_tree stmt2, const unsigned int is_if)
Definition: tree.c:3132
static cb_tree cb_build_search_all(cb_tree table, cb_tree cond)
Definition: typeck.c:7923

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_attribute ( cb_tree  ,
const int  ,
const int   
)

Definition at line 8207 of file typeck.c.

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.

Referenced by yyparse().

8208 {
8209  struct cb_field *f;
8210 
8211  if (cb_validate_one (x)) {
8212  return;
8213  }
8214  if (!CB_REF_OR_FIELD_P (cb_ref (x))) {
8216  _("SET ATTRIBUTE requires a screen item as subject"));
8217  return;
8218  }
8219  f = CB_FIELD_PTR (x);
8220  if (f->storage != CB_STORAGE_SCREEN) {
8222  _("SET ATTRIBUTE subject does not refer to a screen item"));
8223  return;
8224  }
8225  cb_emit (cb_build_set_attribute (f, val_on, val_off));
8226 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
cb_tree cb_build_set_attribute(const struct cb_field *fld, const int val_on, const int val_off)
Definition: tree.c:3226
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define cb_emit(x)
Definition: typeck.c:75
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
struct cb_statement * current_statement
Definition: parser.c:169
enum cb_storage storage
Definition: tree.h:692

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_false ( cb_tree  )

Definition at line 8171 of file typeck.c.

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.

Referenced by yyparse().

8172 {
8173  cb_tree x;
8174  struct cb_field *f;
8175  cb_tree ref;
8176  cb_tree val;
8177 
8178  for (; l; l = CB_CHAIN (l)) {
8179  x = CB_VALUE (l);
8180  if (x == cb_error_node) {
8181  return;
8182  }
8183  if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) &&
8184  !CB_FIELD_P (x)) {
8185  cb_error_x (x, _("Invalid SET statement"));
8186  return;
8187  }
8188  f = CB_FIELD_PTR (x);
8189  if (f->level != 88) {
8190  cb_error_x (x, _("Invalid SET statement"));
8191  return;
8192  }
8193  if (!f->false_88) {
8194  cb_error_x (x, _("Field does not have FALSE clause"));
8195  return;
8196  }
8197  ref = cb_build_field_reference (f->parent, x);
8198  val = CB_VALUE (f->false_88);
8199  if (CB_PAIR_P (val)) {
8200  val = CB_PAIR_X (val);
8201  }
8202  cb_emit (cb_build_move (val, ref));
8203  }
8204 }
#define CB_PAIR_X(x)
Definition: tree.h:1205
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_PAIR_P(x)
Definition: tree.h:1204
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_FIELD_PTR(x)
Definition: tree.h:745
cb_tree cb_build_field_reference(struct cb_field *f, cb_tree ref)
Definition: tree.c:2604
int level
Definition: tree.h:673
#define CB_VALUE(x)
Definition: tree.h:1193
strict implicit external value
Definition: warning.def:54
#define CB_FIELD_P(x)
Definition: tree.h:741
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_error_node
Definition: tree.c:140
struct cb_field * parent
Definition: tree.h:651
#define cb_emit(x)
Definition: typeck.c:75
cb_tree false_88
Definition: tree.h:649

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_last_exception_to_off ( void  )

Definition at line 8229 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_int0.

Referenced by yyparse().

8230 {
8231  cb_emit (CB_BUILD_FUNCALL_1 ("cob_set_exception", cb_int0));
8232 }
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
cb_tree cb_int0
Definition: tree.c:133
#define cb_emit(x)
Definition: typeck.c:75

Here is the caller graph for this function:

void cb_emit_set_on_off ( cb_tree  ,
cb_tree   
)

Definition at line 8124 of file typeck.c.

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.

Referenced by yyparse().

8125 {
8126  struct cb_system_name *s;
8127 
8128  if (cb_validate_list (l)) {
8129  return;
8130  }
8131  for (; l; l = CB_CHAIN (l)) {
8132  s = CB_SYSTEM_NAME (cb_ref (CB_VALUE (l)));
8133  cb_emit (CB_BUILD_FUNCALL_2 ("cob_set_switch",
8134  cb_int (s->token), flag));
8135  }
8136 }
#define CB_SYSTEM_NAME(x)
Definition: tree.h:586
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_CHAIN(x)
Definition: tree.h:1194
cb_tree cb_int(const int n)
Definition: tree.c:1488
int token
Definition: tree.h:583
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_to ( cb_tree  ,
cb_tree   
)

Definition at line 8019 of file typeck.c.

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, and cb_cast::val.

Referenced by yyparse().

8020 {
8021  cb_tree l;
8022  cb_tree v;
8023  struct cb_cast *p;
8024  enum cb_class class;
8025 
8026  if (cb_validate_one (x)) {
8027  return;
8028  }
8029  if (cb_validate_list (vars)) {
8030  return;
8031  }
8032 
8033 #if 0 /* RXWRXW - target check */
8034  /* Determine class of targets */
8035  for (l = vars; l; l = CB_CHAIN (l)) {
8036  if (CB_TREE_CLASS (CB_VALUE (l)) != CB_CLASS_UNKNOWN) {
8037  if (class == CB_CLASS_UNKNOWN) {
8038  class = CB_TREE_CLASS (CB_VALUE (l));
8039  } else if (class != CB_TREE_CLASS (CB_VALUE (l))) {
8040  break;
8041  }
8042  }
8043  }
8044  if (l || (class != CB_CLASS_INDEX && class != CB_CLASS_POINTER)) {
8046  _("The targets of SET must be either indexes or pointers"));
8047  return;
8048  }
8049 #endif
8050 
8051  if (CB_CAST_P (x)) {
8052  p = CB_CAST (x);
8053  if (p->cast_type == CB_CAST_PROGRAM_POINTER) {
8054  for (l = vars; l; l = CB_CHAIN (l)) {
8055  v = CB_VALUE (l);
8056  if (!CB_REFERENCE_P (v)) {
8058  _("SET targets must be PROGRAM-POINTER"));
8059  CB_VALUE (l) = cb_error_node;
8060  } else if (CB_FIELD(cb_ref(v))->usage != CB_USAGE_PROGRAM_POINTER) {
8062  _("SET targets must be PROGRAM-POINTER"));
8063  CB_VALUE (l) = cb_error_node;
8064  }
8065  }
8066  }
8067  }
8068  /* Validate the targets */
8069  for (l = vars; l; l = CB_CHAIN (l)) {
8070  v = CB_VALUE (l);
8071  if (!CB_CAST_P (v)) {
8072  continue;
8073  }
8074  p = CB_CAST (v);
8075  if (p->cast_type == CB_CAST_ADDRESS &&
8076  !CB_FIELD (cb_ref (p->val))->flag_item_based &&
8077  CB_FIELD (cb_ref (p->val))->storage != CB_STORAGE_LINKAGE) {
8078  cb_error_x (p->val, _("The address of '%s' cannot be changed"),
8079  cb_name (p->val));
8080  CB_VALUE (l) = cb_error_node;
8081  }
8082  }
8083  if (cb_validate_list (vars)) {
8084  return;
8085  }
8086 
8087  for (l = vars; l; l = CB_CHAIN (l)) {
8088  class = cb_tree_class (CB_VALUE (l));
8089  switch (class) {
8090  case CB_CLASS_INDEX:
8091  case CB_CLASS_NUMERIC:
8092  case CB_CLASS_POINTER:
8094  cb_emit (cb_build_move (x, CB_VALUE (l)));
8095  break;
8096  default:
8098  _("SET target is invalid - '%s'"),
8099  cb_name (CB_VALUE(l)));
8100  break;
8101  }
8102  }
8103 }
#define CB_TREE(x)
Definition: tree.h:440
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_CAST_P(x)
Definition: tree.h:963
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_CAST(x)
Definition: tree.h:962
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
char * cb_name(cb_tree x)
Definition: tree.c:735
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_TREE_CLASS(x)
Definition: tree.h:442
static void cb_check_data_incompat(cb_tree x)
Definition: typeck.c:719
#define _(s)
Definition: cobcrun.c:59
#define CB_CHAIN(x)
Definition: tree.h:1194
cb_class
Definition: tree.h:213
Definition: tree.h:956
cb_tree cb_error_node
Definition: tree.c:140
enum cb_cast_type cast_type
Definition: tree.h:959
cb_tree val
Definition: tree.h:958
enum cb_class cb_tree_class(cb_tree x)
Definition: tree.c:836
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
struct cb_statement * current_statement
Definition: parser.c:169
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_true ( cb_tree  )

Definition at line 8139 of file typeck.c.

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.

Referenced by yyparse().

8140 {
8141  cb_tree x;
8142  struct cb_field *f;
8143  cb_tree ref;
8144  cb_tree val;
8145 
8146  for (; l; l = CB_CHAIN (l)) {
8147  x = CB_VALUE (l);
8148  if (x == cb_error_node) {
8149  return;
8150  }
8151  if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) &&
8152  !CB_FIELD_P (x)) {
8153  cb_error_x (x, _("Invalid SET statement"));
8154  return;
8155  }
8156  f = CB_FIELD_PTR (x);
8157  if (f->level != 88) {
8158  cb_error_x (x, _("Invalid SET statement"));
8159  return;
8160  }
8161  ref = cb_build_field_reference (f->parent, x);
8162  val = CB_VALUE (f->values);
8163  if (CB_PAIR_P (val)) {
8164  val = CB_PAIR_X (val);
8165  }
8166  cb_emit (cb_build_move (val, ref));
8167  }
8168 }
#define CB_PAIR_X(x)
Definition: tree.h:1205
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_PAIR_P(x)
Definition: tree.h:1204
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_FIELD_PTR(x)
Definition: tree.h:745
cb_tree cb_build_field_reference(struct cb_field *f, cb_tree ref)
Definition: tree.c:2604
int level
Definition: tree.h:673
#define CB_VALUE(x)
Definition: tree.h:1193
strict implicit external value
Definition: warning.def:54
#define CB_FIELD_P(x)
Definition: tree.h:741
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree cb_error_node
Definition: tree.c:140
struct cb_field * parent
Definition: tree.h:651
#define cb_emit(x)
Definition: typeck.c:75
cb_tree values
Definition: tree.h:648

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_up_down ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 8106 of file typeck.c.

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

Referenced by yyparse().

8107 {
8108  if (cb_validate_one (x)) {
8109  return;
8110  }
8111  if (cb_validate_list (l)) {
8112  return;
8113  }
8114  for (; l; l = CB_CHAIN (l)) {
8115  if (flag == cb_int0) {
8116  cb_emit (cb_build_add (CB_VALUE (l), x, cb_int0));
8117  } else {
8118  cb_emit (cb_build_sub (CB_VALUE (l), x, cb_int0));
8119  }
8120  }
8121 }
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_build_add(cb_tree v, cb_tree n, cb_tree round_opt)
Definition: typeck.c:4015
cb_tree cb_build_sub(cb_tree v, cb_tree n, cb_tree round_opt)
Definition: typeck.c:4058
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_CHAIN(x)
Definition: tree.h:1194
cb_tree cb_int0
Definition: tree.c:133
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_setenv ( cb_tree  ,
cb_tree   
)

Definition at line 8013 of file typeck.c.

References CB_BUILD_FUNCALL_2, and cb_emit.

Referenced by yyparse().

8014 {
8015  cb_emit (CB_BUILD_FUNCALL_2 ("cob_set_environment", x, y));
8016 }
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define cb_emit(x)
Definition: typeck.c:75

Here is the caller graph for this function:

void cb_emit_sort_finish ( cb_tree  )

Definition at line 8356 of file typeck.c.

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

Referenced by yyparse().

8357 {
8358  if (CB_FILE_P (cb_ref (file))) {
8359  cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_sort_close", cb_ref (file)));
8360  }
8361 }
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
#define CB_FILE_P(x)
Definition: tree.h:859
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_giving ( cb_tree  ,
cb_tree   
)

Definition at line 8319 of file typeck.c.

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, and current_statement.

Referenced by yyparse().

8320 {
8321  cb_tree p;
8322  int listlen;
8323 
8324  if (cb_validate_list (l)) {
8325  return;
8326  }
8327  for (p = l; p; p = CB_CHAIN (p)) {
8328  if (CB_FILE (cb_ref(CB_VALUE(p)))->organization == COB_ORG_SORT) {
8330  _("Invalid SORT GIVING parameter"));
8331  }
8332  }
8333  listlen = cb_list_length (l);
8334  p = CB_BUILD_FUNCALL_2 ("cob_file_sort_giving", cb_ref (file), l);
8335  CB_FUNCALL(p)->varcnt = listlen;
8336  cb_emit (p);
8337 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_FILE(x)
Definition: tree.h:858
#define CB_FUNCALL(x)
Definition: tree.h:951
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
#define CB_VALUE(x)
Definition: tree.h:1193
int cb_list_length(cb_tree l)
Definition: tree.c:1342
#define _(s)
Definition: cobcrun.c:59
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_CHAIN(x)
Definition: tree.h:1194
#define COB_ORG_SORT
Definition: common.h:746
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_init ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 8237 of file typeck.c.

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.

Referenced by yyparse().

8238 {
8239  cb_tree l;
8240  struct cb_field *f;
8241 
8242  if (cb_validate_list (keys)) {
8243  return;
8244  }
8245  if (cb_ref (name) == cb_error_node) {
8246  return;
8247  }
8248  for (l = keys; l; l = CB_CHAIN (l)) {
8249  if (CB_VALUE (l) == NULL) {
8250  CB_VALUE (l) = name;
8251  }
8252  cb_ref (CB_VALUE (l));
8253  }
8254 
8255  if (CB_FILE_P (cb_ref (name))) {
8256  if (CB_FILE (cb_ref (name))->organization != COB_ORG_SORT) {
8257  cb_error_x (name, _("Invalid SORT filename"));
8258  }
8260  cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", cb_ref (name),
8261  cb_int (cb_list_length (keys)), col,
8263  CB_FILE(cb_ref (name))->file_status));
8264  for (l = keys; l; l = CB_CHAIN (l)) {
8265  cb_emit (CB_BUILD_FUNCALL_4 ("cob_file_sort_init_key",
8266  cb_ref (name),
8267  CB_VALUE (l),
8268  CB_PURPOSE (l),
8269  cb_int (CB_FIELD_PTR (CB_VALUE(l))->offset)));
8270  }
8271  } else {
8272  if (keys == NULL) {
8273  cb_error_x (name, _("Table sort without keys not implemented yet"));
8274  }
8275  cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort_init",
8276  cb_int (cb_list_length (keys)), col));
8277  for (l = keys; l; l = CB_CHAIN (l)) {
8278  cb_emit (CB_BUILD_FUNCALL_3 ("cob_table_sort_init_key",
8279  CB_VALUE (l),
8280  CB_PURPOSE (l),
8282  - CB_FIELD_PTR (CB_VALUE(l))->parent->offset)));
8283  }
8284  f = CB_FIELD (cb_ref (name));
8285  cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort", name,
8286  (f->depending
8288  : cb_int (f->occurs_max))));
8289  }
8290 }
const char * name
Definition: tree.h:645
int occurs_max
Definition: tree.h:677
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_FIELD_PTR(x)
Definition: tree.h:745
#define CB_BUILD_FUNCALL_4(f, a1, a2, a3, a4)
Definition: tree.h:1811
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_PURPOSE(x)
Definition: tree.h:1192
#define CB_FILE(x)
Definition: tree.h:858
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
int cb_list_length(cb_tree l)
Definition: tree.c:1342
cb_tree depending
Definition: tree.h:647
int offset
Definition: tree.h:675
#define CB_BUILD_CAST_ADDRESS(x)
Definition: tree.h:1841
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_sort_return
Definition: tree.h:1266
cb_tree cb_int(const int n)
Definition: tree.c:1488
#define CB_FILE_P(x)
Definition: tree.h:859
cb_tree cb_error_node
Definition: tree.c:140
struct cb_field * parent
Definition: tree.h:651
struct cb_program * current_program
Definition: parser.c:168
#define COB_ORG_SORT
Definition: common.h:746
#define cb_emit(x)
Definition: typeck.c:75
#define CB_BUILD_FUNCALL_5(f, a1, a2, a3, a4, a5)
Definition: tree.h:1815
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
cb_tree cb_build_cast_int(const cb_tree val)
Definition: tree.c:2964
struct cb_key * keys
Definition: tree.h:658
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_input ( cb_tree  )

Definition at line 8309 of file typeck.c.

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.

Referenced by yyparse().

8310 {
8313  cb_emit (cb_build_debug (cb_debug_contents, "SORT INPUT", NULL));
8314  }
8315  cb_emit (cb_build_perform_once (proc));
8316 }
cb_tree cb_build_perform_once(cb_tree body)
Definition: typeck.c:7523
unsigned int flag_debugging
Definition: tree.h:1320
unsigned int flag_in_debug
Definition: tree.h:1150
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
struct cb_program * current_program
Definition: parser.c:168
cb_tree cb_debug_contents
Definition: typeck.c:88
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_output ( cb_tree  )

Definition at line 8340 of file typeck.c.

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.

Referenced by yyparse().

8341 {
8346  "MERGE OUTPUT", NULL));
8347  } else {
8349  "SORT OUTPUT", NULL));
8350  }
8351  }
8352  cb_emit (cb_build_perform_once (proc));
8353 }
cb_tree cb_build_perform_once(cb_tree body)
Definition: typeck.c:7523
unsigned int flag_debugging
Definition: tree.h:1320
unsigned int flag_in_debug
Definition: tree.h:1150
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
struct cb_program * current_program
Definition: parser.c:168
cb_tree cb_debug_contents
Definition: typeck.c:88
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
unsigned int flag_merge
Definition: tree.h:1151
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_using ( cb_tree  ,
cb_tree   
)

Definition at line 8293 of file typeck.c.

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.

Referenced by yyparse().

8294 {
8295  if (cb_validate_list (l)) {
8296  return;
8297  }
8298  for (; l; l = CB_CHAIN (l)) {
8299  if (CB_FILE (cb_ref(CB_VALUE(l)))->organization == COB_ORG_SORT) {
8301  _("Invalid SORT USING parameter"));
8302  }
8303  cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using",
8304  cb_ref (file), cb_ref (CB_VALUE (l))));
8305  }
8306 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
#define CB_VALUE(x)
Definition: tree.h:1193
#define _(s)
Definition: cobcrun.c:59
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_CHAIN(x)
Definition: tree.h:1194
#define COB_ORG_SORT
Definition: common.h:746
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_start ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 8414 of file typeck.c.

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.

Referenced by yyparse().

8415 {
8416  cb_tree kfld;
8417  cb_tree fl;
8418  cb_tree cbtkey;
8419  struct cb_file *f;
8420 
8421  if (cb_validate_one (key)) {
8422  return;
8423  }
8424  if (cb_validate_one (keylen)) {
8425  return;
8426  }
8427  if (file == cb_error_node) {
8428  return;
8429  }
8430  fl = cb_ref (file);
8431  if (fl == cb_error_node) {
8432  return;
8433  }
8434  f = CB_FILE (fl);
8435 
8436  if (f->organization != COB_ORG_INDEXED &&
8439  _("%s not allowed on %s files"), "START", "SEQUENTIAL");
8440  return;
8441  }
8442  if (keylen && f->organization != COB_ORG_INDEXED) {
8444  _("LENGTH/SIZE clause only allowed on INDEXED files"));
8445  return;
8446  }
8447  if (f->access_mode == COB_ACCESS_RANDOM) {
8449  _("START not allowed with ACCESS MODE RANDOM"));
8450  return;
8451  }
8452 
8453  current_statement->file = fl;
8454  if (key) {
8455  kfld = cb_ref (key);
8456  if (kfld == cb_error_node) {
8457  return;
8458  }
8459  if (check_valid_key (f, CB_FIELD_PTR (kfld))) {
8460  return;
8461  }
8462  cbtkey = key;
8463  } else {
8464  cbtkey = f->key;
8465  }
8466 
8467  /* Check for file debugging */
8470  f->flag_fl_debug) {
8471  /* Gen callback after start but before exception test */
8473  }
8474 
8475  cb_emit (CB_BUILD_FUNCALL_5 ("cob_start", fl, op, cbtkey, keylen,
8476  f->file_status));
8477 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
static unsigned int check_valid_key(const struct cb_file *cbf, const struct cb_field *f)
Definition: typeck.c:8366
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define COB_ORG_INDEXED
Definition: common.h:745
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
#define COB_ORG_RELATIVE
Definition: common.h:744
cb_tree file
Definition: tree.h:1140
Definition: tree.h:818
cb_tree cb_error_node
Definition: tree.c:140
int access_mode
Definition: tree.h:845
cb_tree file_status
Definition: tree.h:824
unsigned int flag_fl_debug
Definition: tree.h:854
struct cb_program * current_program
Definition: parser.c:168
int organization
Definition: tree.h:844
#define COB_ACCESS_RANDOM
Definition: common.h:753
unsigned int flag_callback
Definition: tree.h:1152
#define cb_emit(x)
Definition: typeck.c:75
#define CB_BUILD_FUNCALL_5(f, a1, a2, a3, a4, a5)
Definition: tree.h:1815
cb_tree key
Definition: tree.h:826
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_stop_run ( cb_tree  )

Definition at line 8482 of file typeck.c.

References cb_build_cast_int(), CB_BUILD_FUNCALL_1, and cb_emit.

Referenced by yyparse().

8483 {
8484  cb_emit (CB_BUILD_FUNCALL_1 ("cob_stop_run", cb_build_cast_int (x)));
8485 }
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_cast_int(const cb_tree val)
Definition: tree.c:2964

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_string ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 8490 of file typeck.c.

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.

Referenced by yyparse().

8491 {
8492  cb_tree start;
8493  cb_tree l;
8494  cb_tree end;
8495  cb_tree dlm;
8496 
8497  if (cb_validate_one (into)) {
8498  return;
8499  }
8500  if (cb_validate_one (pointer)) {
8501  return;
8502  }
8503  start = items;
8504  cb_emit (CB_BUILD_FUNCALL_2 ("cob_string_init", into, pointer));
8505  while (start) {
8506 
8507  /* Find DELIMITED item */
8508  for (end = start; end; end = CB_CHAIN (end)) {
8509  if (CB_PAIR_P (CB_VALUE (end))) {
8510  break;
8511  }
8512  }
8513 
8514  /* cob_string_delimited */
8515  dlm = end ? CB_PAIR_X (CB_VALUE (end)) : NULL;
8516  if (dlm == cb_int0) {
8517  dlm = NULL;
8518  }
8519  cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_delimited", dlm));
8520 
8521  /* cob_string_append */
8522  for (l = start; l != end; l = CB_CHAIN (l)) {
8523  cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_append",
8524  CB_VALUE (l)));
8525  }
8526 
8527  start = end ? CB_CHAIN (end) : NULL;
8528  }
8529  cb_emit (CB_BUILD_FUNCALL_0 ("cob_string_finish"));
8530 }
#define CB_PAIR_X(x)
Definition: tree.h:1205
#define CB_PAIR_P(x)
Definition: tree.h:1204
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int0
Definition: tree.c:133
#define cb_emit(x)
Definition: typeck.c:75

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_unlock ( cb_tree  )

Definition at line 8535 of file typeck.c.

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.

Referenced by yyparse().

8536 {
8537  cb_tree file;
8538 
8539  if (ref != cb_error_node) {
8540  file = cb_ref (ref);
8541  if (file != cb_error_node) {
8542  cb_emit (CB_BUILD_FUNCALL_2 ("cob_unlock_file",
8543  file, CB_FILE(file)->file_status));
8545  }
8546  }
8547 }
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define CB_FILE(x)
Definition: tree.h:858
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
#define CB_BUILD_FUNCALL_2(f, a1, a2)
Definition: tree.h:1803
cb_tree file
Definition: tree.h:1140
cb_tree cb_error_node
Definition: tree.c:140
cb_tree file_status
Definition: tree.h:824
#define cb_emit(x)
Definition: typeck.c:75
struct cb_statement * current_statement
Definition: parser.c:169

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_unstring ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 8552 of file typeck.c.

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

Referenced by yyparse().

8554 {
8555  if (cb_validate_one (name)) {
8556  return;
8557  }
8558  if (cb_validate_one (tallying)) {
8559  return;
8560  }
8561  if (cb_validate_list (delimited)) {
8562  return;
8563  }
8564  if (cb_validate_list (into)) {
8565  return;
8566  }
8567  cb_emit (CB_BUILD_FUNCALL_3 ("cob_unstring_init", name, pointer,
8568  cb_int (cb_list_length (delimited))));
8569  cb_emit_list (delimited);
8570  cb_emit_list (into);
8571  if (tallying) {
8572  cb_emit (CB_BUILD_FUNCALL_1 ("cob_unstring_tallying", tallying));
8573  }
8574  cb_emit (CB_BUILD_FUNCALL_0 ("cob_unstring_finish"));
8575 }
const char * name
Definition: tree.h:820
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
#define CB_BUILD_FUNCALL_1(f, a1)
Definition: tree.h:1799
#define cb_emit_list(l)
Definition: typeck.c:77
#define CB_BUILD_FUNCALL_3(f, a1, a2, a3)
Definition: tree.h:1807
int cb_list_length(cb_tree l)
Definition: tree.c:1342
#define CB_BUILD_FUNCALL_0(f)
Definition: tree.h:1795
cb_tree cb_int(const int n)
Definition: tree.c:1488
#define cb_emit(x)
Definition: typeck.c:75
static size_t cb_validate_list(cb_tree l)
Definition: typeck.c:581

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_write ( cb_tree  ,
cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 8604 of file typeck.c.

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.

Referenced by yyparse().

8605 {
8606  cb_tree file;
8607  cb_tree check_eop;
8608  struct cb_file *f;
8609 
8610  if (cb_validate_one (record)) {
8611  return;
8612  }
8613  if (cb_validate_one (from)) {
8614  return;
8615  }
8616  if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
8618  _("%s requires a record name as subject"), "WRITE");
8619  return;
8620  }
8621  if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) {
8623  _("%s subject does not refer to a record name"), "WRITE");
8624  return;
8625  }
8626  file = CB_TREE (CB_FIELD (cb_ref (record))->file);
8627  if (!file || file == cb_error_node) {
8628  return;
8629  }
8631  f = CB_FILE (file);
8632 
8633  if (f->organization == COB_ORG_SORT) {
8635  _("%s not allowed on %s files"), "WRITE", "SORT");
8637  (f->organization != COB_ORG_RELATIVE &&
8638  f->organization != COB_ORG_INDEXED)) {
8640  _("INVALID KEY clause invalid with this file type"));
8641  } else if (lockopt) {
8642  if (f->lock_mode & COB_LOCK_AUTOMATIC) {
8644  _("LOCK clause invalid with file LOCK AUTOMATIC"));
8645  } else if (opt != cb_int0) {
8647  _("LOCK clause invalid here"));
8648  } else if (lockopt == cb_int1) {
8649  opt = cb_int (COB_WRITE_LOCK);
8650  }
8651  }
8652 
8653  if (from) {
8654  cb_emit (cb_build_move (from, record));
8655  }
8656 
8657  /* Check debugging on record name */
8660  CB_FIELD_PTR (record)->flag_field_debug) {
8662  CB_FIELD_PTR (record)->name, NULL));
8665  }
8667  opt == cb_int0) {
8668  if (cb_flag_write_after || CB_FILE (file)->flag_line_adv) {
8670  } else {
8672  }
8673  }
8676  check_eop = cb_int1;
8677  } else {
8678  check_eop = cb_int0;
8679  }
8680  cb_emit (CB_BUILD_FUNCALL_5 ("cob_write", file, record, opt,
8681  f->file_status, check_eop));
8682 }
#define COB_WRITE_LINES
Definition: common.h:802
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_int1
Definition: tree.c:134
cb_tree cb_debug_name
Definition: typeck.c:84
unsigned int flag_line_adv
Definition: tree.h:855
const char * name
Definition: tree.h:820
#define COB_LOCK_AUTOMATIC
Definition: common.h:775
int lock_mode
Definition: tree.h:846
cb_tree cb_build_move(cb_tree src, cb_tree dst)
Definition: typeck.c:7333
#define CB_FIELD_PTR(x)
Definition: tree.h:745
static size_t cb_validate_one(cb_tree x)
Definition: typeck.c:545
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
#define COB_ORG_INDEXED
Definition: common.h:745
int handler_id
Definition: tree.h:1148
#define CB_FILE(x)
Definition: tree.h:858
#define COB_WRITE_AFTER
Definition: common.h:805
if fold fold static computed alternate extra correct stack on syntax debugging source implicit stack syntax write single recursive relax optional file
Definition: flag.def:129
unsigned int flag_debugging
Definition: tree.h:1320
struct cb_label * debug_section
Definition: tree.h:839
unsigned int flag_in_debug
Definition: tree.h:1150
#define _(s)
Definition: cobcrun.c:59
cb_tree cb_int_hex(const int n)
Definition: tree.c:1514
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree cb_int0
Definition: tree.c:133
#define COB_ORG_RELATIVE
Definition: common.h:744
cb_tree cb_build_debug_call(struct cb_label *target)
Definition: tree.c:1590
cb_tree cb_int(const int n)
Definition: tree.c:1488
cb_tree file
Definition: tree.h:1140
Definition: tree.h:818
cb_tree cb_error_node
Definition: tree.c:140
#define COB_WRITE_BEFORE
Definition: common.h:806
cb_tree file_status
Definition: tree.h:824
struct cb_program * current_program
Definition: parser.c:168
struct cb_field * record
Definition: tree.h:829
int organization
Definition: tree.h:844
#define COB_ORG_SORT
Definition: common.h:746
cb_tree cb_debug_contents
Definition: typeck.c:88
#define COB_ORG_LINE_SEQUENTIAL
Definition: common.h:743
#define cb_emit(x)
Definition: typeck.c:75
cb_tree cb_build_debug(const cb_tree target, const char *str, const cb_tree fld)
Definition: tree.c:1566
#define CB_BUILD_FUNCALL_5(f, a1, a2, a3, a4, a5)
Definition: tree.h:1815
#define COB_WRITE_LOCK
Definition: common.h:808
cb_tree handler1
Definition: tree.h:1141
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
struct cb_statement * current_statement
Definition: parser.c:169
#define CB_FIELD(x)
Definition: tree.h:740

Here is the call graph for this function:

Here is the caller graph for this function:

char* cb_encode_program_id ( const char *  )

Definition at line 1132 of file typeck.c.

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

Referenced by cb_build_program_id(), emit_entry(), output_call(), output_cancel(), process_filename(), and user_func_upper().

1133 {
1134  unsigned char *p;
1135  const unsigned char *s;
1136  const unsigned char *t;
1137  unsigned char buff[COB_MINI_BUFF];
1138 
1139  s = NULL;
1140  for (t = (const unsigned char *)name; *t; t++) {
1141  if (*t == (unsigned char)'/' || *t == (unsigned char)'\\') {
1142  s = t + 1;
1143  }
1144  }
1145  if (!s) {
1146  s = (const unsigned char *)name;
1147  }
1148  p = buff;
1149  /* Encode the initial digit */
1150  if (*s <= (unsigned char)'9' && *s >= (unsigned char)'0') {
1151  *p++ = (unsigned char)'_';
1152  }
1153  /* Encode invalid letters */
1154  for (; *s; s++) {
1155  if (likely(valid_char[*s])) {
1156  *p++ = *s;
1157  } else {
1158  *p++ = (unsigned char)'_';
1159  if (*s == (unsigned char)'-') {
1160  *p++ = (unsigned char)'_';
1161  } else {
1162  *p++ = hexval[*s / 16U];
1163  *p++ = hexval[*s % 16U];
1164  }
1165  }
1166  }
1167  *p = 0;
1168 
1169  /* Check case folding */
1170  if (unlikely(cb_fold_call)) {
1171  if (cb_fold_call == COB_FOLD_UPPER) {
1172  for (p = buff; *p; p++) {
1173  if (islower (*p)) {
1174  *p = (cob_u8_t)toupper (*p);
1175  }
1176  }
1177  } else if (cb_fold_call == COB_FOLD_LOWER) {
1178  for (p = buff; *p; p++) {
1179  if (isupper (*p)) {
1180  *p = (cob_u8_t)tolower (*p);
1181  }
1182  }
1183  }
1184  }
1185 
1186  return cobc_check_string ((char *)buff);
1187 }
const char * name
Definition: tree.h:820
#define COB_MINI_BUFF
Definition: common.h:539
void * cobc_check_string(const char *dupstr)
Definition: cobc.c:951
#define cob_u8_t
Definition: common.h:27
static unsigned char valid_char[256]
Definition: typeck.c:200
#define unlikely(x)
Definition: common.h:437
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static const unsigned char hexval[]
Definition: typeck.c:109
#define COB_FOLD_LOWER
Definition: common.h:587
#define COB_FOLD_UPPER
Definition: common.h:586
#define likely(x)
Definition: common.h:436

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 233 of file error.c.

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

Referenced by ambiguous_error(), begin_scope_of_program_name(), 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_concat_literals(), 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_initialize(), 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_expr_finish(), 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_for_duplicate_prototype(), 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(), validate_move(), warn_cannot_get_utc(), and yyparse().

234 {
235  va_list ap;
236 
237  va_start (ap, fmt);
238  print_error (x->source_file, x->source_line, _("Error: "), fmt, ap);
239  va_end (ap);
240  if (++errorcount > 100) {
242  }
243 }
#define _(s)
Definition: cobcrun.c:59
void cobc_too_many_errors(void)
Definition: cobc.c:599
int errorcount
Definition: cobc.c:173
static void print_error(const char *file, int line, const char *prefix, const char *fmt, va_list ap)
Definition: error.c:46

Here is the call graph for this function:

struct cb_field* cb_field_add ( struct cb_field ,
struct cb_field  
)

Definition at line 2212 of file tree.c.

References NULL, and cb_field::sister.

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

Definition at line 2227 of file tree.c.

References cb_field::parent.

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

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

Here is the caller graph for this function:

int cb_field_subordinate ( const struct cb_field ,
const struct cb_field  
)

Definition at line 2274 of file tree.c.

References cb_field::parent.

Referenced by output_size().

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

Here is the caller graph for this function:

unsigned int cb_field_variable_address ( const struct cb_field )

Definition at line 2255 of file tree.c.

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

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

Here is the call graph for this function:

struct cb_field* cb_field_variable_size ( const struct cb_field )

Definition at line 2239 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_program* cb_find_defined_program_by_id ( const char *  )

Definition at line 4905 of file scanner.c.

References CB_CHAIN, CB_PROGRAM, CB_VALUE, defined_prog_list, NULL, and cb_program::orig_program_id.

Referenced by check_prototype_seen().

4906 {
4907  cb_tree l;
4908  cb_tree x;
4909 
4910  for (l = defined_prog_list; l; l = CB_CHAIN (l)) {
4911  x = CB_VALUE (l);
4912  if (strcmp (orig_id, CB_PROGRAM (x)->orig_program_id) == 0) {
4913  return CB_PROGRAM (x);
4914  }
4915  }
4916 
4917  return NULL;
4918 }
struct cb_tree_common * defined_prog_list
Definition: parser.c:172
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_PROGRAM(x)
Definition: tree.h:1328

Here is the caller graph for this function:

struct cb_program* cb_find_defined_program_by_name ( const char *  )

Definition at line 4882 of file scanner.c.

References CB_CHAIN, CB_PROGRAM, CB_VALUE, defined_prog_list, NULL, and cb_program::program_name.

Referenced by yylex().

4883 {
4884  int (*cmp_func)(const char *, const char *);
4885  cb_tree l;
4886  cb_tree x;
4887 
4888  if (cb_fold_call) {
4889  cmp_func = &strcasecmp;
4890  } else {
4891  cmp_func = &strcmp;
4892  }
4893 
4894  for (l = defined_prog_list; l; l = CB_CHAIN (l)) {
4895  x = CB_VALUE (l);
4896  if ((*cmp_func)(name, CB_PROGRAM (x)->program_name) == 0) {
4897  return CB_PROGRAM (x);
4898  }
4899  }
4900 
4901  return NULL;
4902 }
const char * name
Definition: tree.h:645
struct cb_tree_common * defined_prog_list
Definition: parser.c:172
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_PROGRAM(x)
Definition: tree.h:1328

Here is the caller graph for this function:

int cb_fits_int ( const cb_tree  )

Definition at line 914 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_fits_long_long ( const cb_tree  )

Definition at line 991 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_get_int ( const cb_tree  )

Definition at line 1101 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_get_level ( cb_tree  )

Definition at line 46 of file field.c.

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

Referenced by cb_build_field_tree(), and yyparse().

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 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define _(s)
Definition: cobcrun.c:59
#define CB_NAME(x)
Definition: tree.h:904
#define CB_INVALID_TREE(x)
Definition: tree.h:446

Here is the call graph for this function:

Here is the caller graph for this function:

cob_s64_t cb_get_long_long ( const cb_tree  )

Definition at line 1175 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_field* cb_get_real_field ( void  )

Definition at line 1445 of file field.c.

References last_real_field.

Referenced by yyparse().

1446 {
1447  return last_real_field;
1448 }
static struct cb_field * last_real_field
Definition: field.c:41

Here is the caller graph for this function:

cob_u64_t cb_get_u_long_long ( const cb_tree  )

Definition at line 1223 of file tree.c.

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

Referenced by output_call(), and output_call_by_value_args().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_init_constants ( void  )

Definition at line 1259 of file tree.c.

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

Referenced by process_translate().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_init_tallying ( void  )

Definition at line 5849 of file typeck.c.

References inspect_func, and NULL.

Referenced by yyparse().

5850 {
5851  inspect_func = NULL;
5852  inspect_data = NULL;
5853 }
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static cb_tree inspect_data
Definition: typeck.c:97
static const char * inspect_func
Definition: typeck.c:96

Here is the caller graph for this function:

void cb_insert_common_prog ( struct cb_program ,
struct cb_program  
)

Definition at line 1479 of file tree.c.

References add_contained_prog(), and cb_program::nested_prog_list.

Referenced by process_translate().

1480 {
1481  prog->nested_prog_list = add_contained_prog (prog->nested_prog_list,
1482  comprog);
1483 }
static struct nested_list * add_contained_prog(struct nested_list *parent_list, struct cb_program *child_prog)
Definition: tree.c:1383

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_int ( const int  )

Definition at line 1488 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_int_hex ( const int  )

Definition at line 1514 of file tree.c.

References cb_int(), and CB_INTEGER.

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_list_append ( cb_tree  ,
cb_tree   
)

Definition at line 1305 of file tree.c.

References CB_CHAIN, get_last_elt(), and NULL.

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_list_intrinsics ( void  )

Definition at line 3052 of file reserved.c.

References _, cb_intrinsic_table::args, cob_free(), cob_malloc(), cb_intrinsic_table::implemented, cb_intrinsic_table::min_args, and NUM_INTRINSICS.

Referenced by process_command_line().

3053 {
3054  const char *s;
3055  const char *t;
3056  char *argnum;
3057  size_t i;
3058  size_t n;
3059 
3060  putchar ('\n');
3061  puts (_("Intrinsic Function\t\tImplemented\tParameters"));
3062  for (i = 0; i < NUM_INTRINSICS; ++i) {
3063  n = strlen (function_list[i].name);
3064  switch (n / 8) {
3065  case 0:
3066  s = "\t\t\t\t";
3067  break;
3068  case 1:
3069  s = "\t\t\t";
3070  break;
3071  case 2:
3072  s = "\t\t";
3073  break;
3074  default:
3075  s = "\t";
3076  break;
3077  }
3078  if (function_list[i].implemented) {
3079  t = _("Y");
3080  } else {
3081  t = _("N");
3082  }
3083  if (function_list[i].args == -1) {
3084  printf ("%s%s%s\t\t%s\n", function_list[i].name, s, t, _("Unlimited"));
3085  } else {
3086  if (function_list[i].args != function_list[i].min_args) {
3087  argnum = cob_malloc (7);
3088  snprintf (argnum, 7, "%d - %d", (int)function_list[i].min_args,
3089  (int)function_list[i].args);
3090  } else {
3091  argnum = cob_malloc (3);
3092  snprintf (argnum, 3, "%d", (int)function_list[i].args);
3093  }
3094  printf ("%s%s%s\t\t%s\n", function_list[i].name, s, t, argnum);
3095  cob_free (argnum);
3096  }
3097  }
3098 }
void cob_free(void *mptr)
Definition: common.c:1284
int n
Definition: tree.c:81
#define NUM_INTRINSICS
Definition: reserved.c:2490
static const struct cb_intrinsic_table function_list[]
Definition: reserved.c:1965
#define _(s)
Definition: cobcrun.c:59
void * cob_malloc(const size_t size)
Definition: common.c:1250

Here is the call graph for this function:

Here is the caller graph for this function:

int cb_list_length ( cb_tree  )

Definition at line 1342 of file tree.c.

References CB_CHAIN.

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

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

Here is the caller graph for this function:

void cb_list_map ( cb_tree(*)(cb_tree ,
cb_tree   
)
void cb_list_mnemonics ( void  )

Definition at line 3101 of file reserved.c.

References _, cb_intrinsic_table::category, EXT_SYSTEM_TAB_SIZE, res_get_feature(), and SYSTEM_TAB_SIZE.

Referenced by process_command_line().

3102 {
3103  const char *tabs;
3104  const char *feature;
3105  size_t i;
3106 
3107  putchar ('\n');
3108  puts (_("Mnemonic names"));
3109  for (i = 0; i < SYSTEM_TAB_SIZE; ++i) {
3110  if (strlen (system_table[i].name) < 8) {
3111  tabs = "\t\t";
3112  } else {
3113  tabs = "\t";
3114  }
3115  feature = res_get_feature (system_table[i].category);
3116  printf ("%s%s%s\n", system_table[i].name, tabs, feature);
3117  }
3118  putchar ('\n');
3119  puts (_("Extended mnemonic names (with -fsyntax-extension)"));
3120  for (i = 0; i < EXT_SYSTEM_TAB_SIZE; ++i) {
3121  if (strlen (ext_system_table[i].name) < 8) {
3122  tabs = "\t\t";
3123  } else {
3124  tabs = "\t";
3125  }
3126  feature = res_get_feature (ext_system_table[i].category);
3127  printf ("%s%s%s\n", ext_system_table[i].name, tabs, feature);
3128  }
3129 }
#define SYSTEM_TAB_SIZE
Definition: reserved.c:114
static const char * res_get_feature(const enum cb_system_name_category category)
Definition: reserved.c:2577
#define _(s)
Definition: cobcrun.c:59
#define EXT_SYSTEM_TAB_SIZE
Definition: reserved.c:188
static const struct system_struct ext_system_table[]
Definition: reserved.c:116

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_list_reserved ( void  )

Definition at line 2989 of file reserved.c.

References _, initialize_reserved_words_if_needed(), num_reserved_words, and cb_intrinsic_table::token.

Referenced by process_command_line().

2990 {
2991  const char *s;
2992  const char *p;
2993  size_t i;
2994  size_t n;
2995 
2997 
2998  putchar ('\n');
2999  printf (_("Reserved Words\t\t\tImplemented (Y/N)"));
3000  puts ("\n");
3001  for (i = 0; i < num_reserved_words; ++i) {
3002  n = strlen (reserved_words[i].name);
3003  switch (n / 8) {
3004  case 0:
3005  s = "\t\t\t\t";
3006  break;
3007  case 1:
3008  s = "\t\t\t";
3009  break;
3010  case 2:
3011  s = "\t\t";
3012  break;
3013  default:
3014  s = "\t";
3015  break;
3016  }
3017  if (reserved_words[i].token > 0) {
3018  if (reserved_words[i].context_sens) {
3019  p = _("Y (Context sensitive)");
3020  } else {
3021  p = _("Y");
3022  }
3023  } else {
3024  if (reserved_words[i].context_sens) {
3025  p = _("N (Context sensitive)");
3026  } else {
3027  p = _("N");
3028  }
3029  }
3030  printf ("%s%s%s\n", reserved_words[i].name, s, p);
3031  }
3032  putchar ('\n');
3033  puts (_("Extra (obsolete) context sensitive words"));
3034  puts ("AUTHOR");
3035  puts ("DATE-COMPILED");
3036  puts ("DATE-MODIFIED");
3037  puts ("DATE-WRITTEN");
3038  puts ("INSTALLATION");
3039  puts ("REMARKS");
3040  puts ("SECURITY");
3041  putchar ('\n');
3042  puts (_("Extra internal registers\tDefinition"));
3043  puts ("RETURN-CODE\t\t\tUSAGE BINARY-LONG");
3044  puts ("SORT-RETURN\t\t\tUSAGE BINARY-LONG");
3045  puts ("NUMBER-OF-CALL-PARAMETERS\tUSAGE BINARY-LONG");
3046  puts ("COB-CRT-STATUS\t\t\tPIC 9(4)");
3047  puts ("TALLY\t\t\t\tGLOBAL PIC 9(5) USAGE BINARY VALUE ZERO");
3048  puts ("'LENGTH OF' phrase\t\tUSAGE BINARY-LONG");
3049 }
static size_t num_reserved_words
Definition: reserved.c:1953
int n
Definition: tree.c:81
static void initialize_reserved_words_if_needed(void)
Definition: reserved.c:2846
static struct cobc_reserved * reserved_words
Definition: reserved.c:198
#define _(s)
Definition: cobcrun.c:59

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_list_reverse ( cb_tree  )

Definition at line 1327 of file tree.c.

References CB_CHAIN, and NULL.

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

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

Here is the caller graph for this function:

void cb_list_system ( void  )

Definition at line 833 of file typeck.c.

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

Referenced by process_command_line().

834 {
835  const struct system_table *psyst;
836  const char *s;
837  size_t n;
838 
839  putchar ('\n');
840  printf (_("System routine\t\t\tParameters"));
841  puts ("\n");
842  for (psyst = system_tab; psyst->syst_name; psyst++) {
843  switch (*(unsigned char *)(psyst->syst_name)) {
844  case 'C':
845  case 'S':
846  printf ("%s", psyst->syst_name);
847  break;
848  case 0xF4:
849  printf ("X\"F4\"");
850  break;
851  case 0xF5:
852  printf ("X\"F5\"");
853  break;
854  case 0x91:
855  printf ("X\"91\"");
856  break;
857  case 0xE4:
858  printf ("X\"E4\"");
859  break;
860  case 0xE5:
861  printf ("X\"E5\"");
862  break;
863  default:
864  break;
865  }
866  n = strlen (psyst->syst_name);
867  switch (n / 8) {
868  case 0:
869  s = "\t\t\t\t";
870  break;
871  case 1:
872  s = "\t\t\t";
873  break;
874  case 2:
875  s = "\t\t";
876  break;
877  default:
878  s = "\t";
879  break;
880  }
881  printf ("%s%d\n", s, psyst->syst_params);
882  }
883 }
static const struct system_table system_tab[]
Definition: typeck.c:282
#define _(s)
Definition: cobcrun.c:59
const int syst_params
Definition: typeck.c:48
const char * syst_name
Definition: codegen.c:66

Here is the caller graph for this function:

cb_tree cb_pair_add ( cb_tree  ,
cb_tree  ,
cb_tree   
)

Definition at line 1321 of file tree.c.

References CB_BUILD_PAIR, and cb_list_append().

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

Here is the call graph for this function:

cb_tree cb_ref ( cb_tree  )

Definition at line 2653 of file tree.c.

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

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

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

Here is the call graph for this function:

void cb_reset_78 ( void  )

Definition at line 4771 of file scanner.c.

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

Referenced by cb_build_program().

4772 {
4773  struct cb_level_78 *p78;
4774  struct cb_level_78 *p782;
4775 
4776  /* Remove constant (78 level) items for current program */
4777  for (p78 = lev78ptr; p78; ) {
4778  p782 = p78->next;
4779  cobc_free (p78);
4780  p78 = p782;
4781  }
4782  lev78ptr = NULL;
4783  for (p78 = globlev78ptr; p78; p78 = p78->next) {
4784  p78->not_const = 0;
4785  }
4786  if (globlev78ptr) {
4788  } else {
4789  top78ptr = const78ptr;
4790  }
4791 }
static struct cb_level_78 * globlev78ptr
Definition: scanner.c:1439
void cobc_free(void *mptr)
Definition: cobc.c:657
struct cb_level_78 * next
Definition: scanner.c:1418
static struct cb_level_78 * lev78ptr
Definition: scanner.c:1438
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static struct cb_level_78 * const78ptr
Definition: scanner.c:1437
static struct cb_level_78 * top78ptr
Definition: scanner.c:1436
cob_u32_t not_const
Definition: scanner.c:1426

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_reset_global_78 ( void  )

Definition at line 4794 of file scanner.c.

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

Referenced by cb_build_program().

4795 {
4796  struct cb_level_78 *p78;
4797  struct cb_level_78 *p782;
4798 
4799  /* Remove constant (78 level) items for top program */
4800  for (p78 = globlev78ptr; p78; ) {
4801  p782 = p78->next;
4802  cobc_free (p78);
4803  p78 = p782;
4804  }
4805  globlev78ptr = NULL;
4806  top78ptr = const78ptr;
4807 }
static struct cb_level_78 * globlev78ptr
Definition: scanner.c:1439
void cobc_free(void *mptr)
Definition: cobc.c:657
struct cb_level_78 * next
Definition: scanner.c:1418
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static struct cb_level_78 * const78ptr
Definition: scanner.c:1437
static struct cb_level_78 * top78ptr
Definition: scanner.c:1436

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_field* cb_resolve_redefines ( struct cb_field ,
cb_tree   
)

Definition at line 247 of file field.c.

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.

Referenced by yyparse().

248 {
249  struct cb_field *f;
250  struct cb_reference *r;
251  const char *name;
252  cb_tree x;
253  cb_tree candidate;
254  cb_tree items;
255 
256  r = CB_REFERENCE (redefines);
257  name = CB_NAME (redefines);
258  x = CB_TREE (field);
259 
260  /* Check qualification */
261  if (r->chain) {
262  cb_error_x (x, _("'%s' cannot be qualified here"), name);
263  return NULL;
264  }
265 
266  /* Check subscripts */
267  if (r->subs) {
268  cb_error_x (x, _("'%s' cannot be subscripted here"), name);
269  return NULL;
270  }
271 
272  /* Resolve the name in the current group (if any) */
273  if (field->parent && field->parent->children) {
274  for (f = field->parent->children; f; f = f->sister) {
275  if (strcasecmp (f->name, name) == 0) {
276  break;
277  }
278  }
279  if (f == NULL) {
280  cb_error_x (x, _("'%s' is not defined in '%s'"), name, field->parent->name);
281  return NULL;
282  }
283  } else {
284  /* Get last defined name */
285  candidate = NULL;
286  items = r->word->items;
287  for (; items; items = CB_CHAIN (items)) {
288  if (CB_FIELD_P (CB_VALUE (items))) {
289  candidate = CB_VALUE (items);
290  }
291  }
292  if (!candidate) {
293  undefined_error (redefines);
294  return NULL;
295  }
296  f = CB_FIELD_PTR (candidate);
297  }
298 
299  /* Check level number */
300  if (f->level != field->level) {
301  cb_error_x (x, _("Level number of REDEFINES entries must be identical"));
302  return NULL;
303  }
304  if (f->level == 66 || f->level == 88) {
305  cb_error_x (x, _("Level number of REDEFINES entry cannot be 66 or 88"));
306  return NULL;
307  }
308 
309  if (!cb_indirect_redefines && f->redefines) {
310  cb_error_x (x, _("'%s' not the original definition"), f->name);
311  return NULL;
312  }
313 
314  /* Return the original definition */
315  while (f->redefines) {
316  f = f->redefines;
317  }
318  return f;
319 }
const char * name
Definition: tree.h:645
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
struct cb_field * sister
Definition: tree.h:653
struct cb_field * children
Definition: tree.h:652
#define CB_FIELD_PTR(x)
Definition: tree.h:745
int level
Definition: tree.h:673
#define CB_VALUE(x)
Definition: tree.h:1193
cb_tree chain
Definition: tree.h:875
#define CB_FIELD_P(x)
Definition: tree.h:741
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_NAME(x)
Definition: tree.h:904
#define CB_REFERENCE(x)
Definition: tree.h:901
void undefined_error(cb_tree x)
Definition: error.c:317
cb_tree items
Definition: tree.h:866
struct cb_field * parent
Definition: tree.h:651
cb_tree subs
Definition: tree.h:877
struct cb_field * redefines
Definition: tree.h:654
struct cb_word * word
Definition: tree.h:881

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_set_system_names ( void  )

Definition at line 2637 of file tree.c.

References cb_define_system_name().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

char* cb_to_cname ( const char *  )

Definition at line 705 of file tree.c.

References cob_u8_t, cobc_parse_strdup(), and copy.

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

enum cb_category cb_tree_category ( cb_tree  )

Definition at line 745 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

enum cb_class cb_tree_class ( cb_tree  )

Definition at line 836 of file tree.c.

References category_to_class_table, and CB_TREE_CATEGORY.

Referenced by cb_emit_set_to().

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

Here is the caller graph for this function:

int cb_tree_type ( const cb_tree  ,
const struct cb_field  
)

Definition at line 849 of file tree.c.

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_unput_dot ( void  )

Definition at line 4765 of file scanner.c.

References unput.

Referenced by yyparse().

4766 {
4767  unput ('.');
4768 }
#define unput(c)
Definition: scanner.c:196

Here is the caller graph for this function:

struct cb_field* cb_validate_78_item ( struct cb_field ,
const cob_u32_t   
)

Definition at line 1415 of file field.c.

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(), cb_build_symbolic_chars(), and yyparse().

1416 {
1417  cb_tree x;
1418  cob_u32_t noadd;
1419 
1420  x = CB_TREE (f);
1421  noadd = no78add;
1422  if (CB_INVALID_TREE(f->values) ||
1423  CB_INVALID_TREE(CB_VALUE(f->values))) {
1424  level_require_error (x, "VALUE");
1425  noadd = 1;
1426  }
1427 
1428  if (f->pic || f->flag_occurs) {
1429  level_except_error (x, "VALUE");
1430  noadd = 1;
1431  }
1432  if (!noadd) {
1433  cb_add_78 (f);
1434  }
1435  return last_real_field;
1436 }
#define CB_TREE(x)
Definition: tree.h:440
#define cob_u32_t
Definition: common.h:31
void level_except_error(cb_tree x, const char *clause)
Definition: error.c:441
#define CB_VALUE(x)
Definition: tree.h:1193
static struct cb_field * last_real_field
Definition: field.c:41
void cb_add_78(struct cb_field *f)
Definition: scanner.c:4810
#define CB_INVALID_TREE(x)
Definition: tree.h:446
void level_require_error(cb_tree x, const char *clause)
Definition: error.c:423

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_88_item ( struct cb_field )

Definition at line 1386 of file field.c.

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.

Referenced by yyparse().

1387 {
1388  cb_tree x;
1389  cb_tree l;
1390  cb_tree t;
1391 
1392  x = CB_TREE (f);
1393  if (!f->values) {
1394  level_require_error (x, "VALUE");
1395  return;
1396  }
1397 
1398  if (f->pic || f->flag_occurs) {
1399  level_except_error (x, "VALUE");
1400  return;
1401  }
1402  if (CB_VALID_TREE(f->parent) &&
1403  CB_TREE_CLASS (f->parent) == CB_CLASS_NUMERIC) {
1404  for (l = f->values; l; l = CB_CHAIN (l)) {
1405  t = CB_VALUE (l);
1406  if (t == cb_space || t == cb_low ||
1407  t == cb_high || t == cb_quote) {
1408  cb_error_x (x, _("Literal type does not match data type"));
1409  }
1410  }
1411  }
1412 }
#define CB_TREE(x)
Definition: tree.h:440
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_VALID_TREE(x)
Definition: tree.h:445
cb_tree cb_quote
Definition: tree.c:132
cb_tree cb_space
Definition: tree.c:127
void level_except_error(cb_tree x, const char *clause)
Definition: error.c:441
#define CB_VALUE(x)
Definition: tree.h:1193
#define CB_TREE_CLASS(x)
Definition: tree.h:442
#define _(s)
Definition: cobcrun.c:59
#define CB_CHAIN(x)
Definition: tree.h:1194
cb_tree cb_high
Definition: tree.c:129
void level_require_error(cb_tree x, const char *clause)
Definition: error.c:423
cb_tree cb_low
Definition: tree.c:128

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_field ( struct cb_field )

Definition at line 1338 of file field.c.

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_build_registers(), cb_validate_program_data(), finalize_file(), and yyparse().

1339 {
1340  struct cb_field *c;
1341 
1342  if (f->flag_is_verified) {
1343  return;
1344  }
1345  if (validate_field_1 (f) != 0) {
1346  f->flag_invalid = 1;
1347  return;
1348  }
1349  if (f->flag_item_78) {
1350  f->flag_is_verified = 1;
1351  return;
1352  }
1353 
1354  /* Set up parameters */
1355  if (f->storage == CB_STORAGE_LOCAL ||
1356  f->storage == CB_STORAGE_LINKAGE ||
1357  f->flag_item_based) {
1358  f->flag_local = 1;
1359  }
1360  if (f->storage == CB_STORAGE_LINKAGE || f->flag_item_based) {
1361  f->flag_base = 1;
1362  }
1363  setup_parameters (f);
1364 
1365  /* Compute size */
1366  occur_align_size = 1;
1367  compute_size (f);
1368  if (!f->redefines) {
1369  f->memory_size = f->size * f->occurs_max;
1370  } else if (f->redefines->memory_size < f->size * f->occurs_max) {
1371  f->redefines->memory_size = f->size * f->occurs_max;
1372  }
1373 
1375  if (f->flag_is_global) {
1376  f->count++;
1377  for (c = f->children; c; c = c->sister) {
1378  c->flag_is_global = 1;
1379  c->count++;
1380  }
1381  }
1382  f->flag_is_verified = 1;
1383 }
struct cb_field * sister
Definition: tree.h:653
struct cb_field * children
Definition: tree.h:652
static int compute_size(struct cb_field *f)
Definition: field.c:1090
unsigned char flag_is_global
Definition: tree.h:699
static int occur_align_size
Definition: field.c:42
static unsigned int validate_field_1(struct cb_field *f)
Definition: field.c:418
Definition: tree.h:643
int count
Definition: tree.h:680
unsigned int flag_invalid
Definition: tree.h:716
static int validate_field_value(struct cb_field *f)
Definition: field.c:1322
static void setup_parameters(struct cb_field *f)
Definition: field.c:845

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_program_body ( struct cb_program )

Definition at line 2554 of file typeck.c.

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.

Referenced by clean_up_program(), set_up_program(), and yyparse().

2555 {
2556  cb_tree l;
2557  cb_tree x;
2558  cb_tree v;
2559  struct cb_label *save_section;
2560  struct cb_label *save_paragraph;
2561  struct cb_alter_id *aid;
2562  struct cb_label *l1;
2563  struct cb_label *l2;
2564  struct cb_field *f;
2565  int size;
2566 
2567  /* Resolve all labels */
2568  save_section = current_section;
2569  save_paragraph = current_paragraph;
2570  for (l = cb_list_reverse (prog->label_list); l; l = CB_CHAIN (l)) {
2571  x = CB_VALUE (l);
2572  current_section = CB_REFERENCE (x)->section;
2573  current_paragraph = CB_REFERENCE (x)->paragraph;
2574  v = cb_ref (x);
2575  /* Check refs in to / out of DECLARATIVES */
2576  if (CB_LABEL_P (v)) {
2577  if (CB_REFERENCE (x)->flag_in_decl &&
2578  !CB_LABEL (v)->flag_declaratives) {
2579  if (!cb_relaxed_syntax_check) {
2580  cb_error_x (x, _("'%s' is not in DECLARATIVES"),
2581  CB_LABEL (v)->name);
2582  } else {
2583  cb_warning_x (x, _("'%s' is not in DECLARATIVES"),
2584  CB_LABEL (v)->name);
2585  }
2586  }
2587  if (CB_LABEL (v)->flag_declaratives &&
2588  !CB_REFERENCE (x)->flag_in_decl &&
2589  !CB_REFERENCE (x)->flag_decl_ok) {
2590  cb_error_x (x, _("Invalid reference to '%s' (In DECLARATIVES)"), CB_LABEL (v)->name);
2591  }
2592  CB_LABEL (v)->flag_begin = 1;
2593  if (CB_REFERENCE (x)->length) {
2594  CB_LABEL (v)->flag_return = 1;
2595  }
2596  } else if (v != cb_error_node) {
2597  cb_error_x (x, _("'%s' not a procedure name"), cb_name (x));
2598  }
2599  }
2600 
2601  /* Resolve DEBUG references */
2602  /* For data items, we may need to adjust the size of DEBUG-CONTENTS */
2603  /* Basic size of DEBUG-CONTENTS is 31 */
2604  size = 31;
2605  for (l = prog->debug_list; l; l = CB_CHAIN (l)) {
2606  x = CB_VALUE (l);
2607  current_section = CB_REFERENCE (x)->section;
2608  current_paragraph = CB_REFERENCE (x)->paragraph;
2609  v = cb_ref (x);
2610  if (v == cb_error_node) {
2611  continue;
2612  }
2613  switch (CB_TREE_TAG (v)) {
2614  case CB_TAG_LABEL:
2616  cb_error_x (x, _("'%s' - DEBUGGING target invalid with ALL PROCEDURES"),
2617  cb_name (x));
2618  }
2619  if (!CB_LABEL (v)->flag_real_label) {
2620  cb_error_x (x, _("'%s' - DEBUGGING target invalid"),
2621  cb_name (x));
2622  }
2623  CB_LABEL (v)->debug_section =
2624  CB_REFERENCE (x)->debug_section;
2625  CB_LABEL (v)->flag_debugging_mode = 1;
2626  break;
2627  case CB_TAG_FILE:
2628  break;
2629  case CB_TAG_FIELD:
2630  if (CB_FIELD (v)->size > size) {
2631  size = CB_FIELD (v)->size;
2632  }
2633  break;
2634  default:
2635  cb_error_x (x, _("'%s' is not a valid DEBUGGING target"),
2636  cb_name (x));
2637  break;
2638  }
2639  }
2640  /* If necessary, adjust size of DEBUG-CONTENTS (and DEBUG-ITEM) */
2642  if (size != 31) {
2644  f->size = size;
2645  f->memory_size = size;
2646  size -= 31;
2648  f->size += size;
2649  f->memory_size += size;
2650  }
2651  }
2652 
2653  /* Build ALTER ids - We need to remove duplicates */
2654  for (l = prog->alter_list; l; l = CB_CHAIN (l)) {
2655  if (CB_PURPOSE (l) == cb_error_node) {
2656  continue;
2657  }
2658  if (CB_VALUE (l) == cb_error_node) {
2659  continue;
2660  }
2661  x = CB_PURPOSE (l);
2662  v = CB_VALUE (l);
2663  if (CB_REFERENCE (x)->value == cb_error_node) {
2664  continue;
2665  }
2666  if (CB_REFERENCE (v)->value == cb_error_node) {
2667  continue;
2668  }
2669  l1 = CB_LABEL (CB_REFERENCE (x)->value);
2670  l2 = CB_LABEL (CB_REFERENCE (v)->value);
2671  current_section = CB_REFERENCE (x)->section;
2672  current_paragraph = CB_REFERENCE (x)->paragraph;
2673  /* First statement in paragraph must be a GO TO */
2674  if (!l1->flag_first_is_goto) {
2675  cb_error_x (x, _("'%s' is not an alterable paragraph"),
2676  l1->name);
2677  continue;
2678  }
2679  for (aid = l1->alter_gotos; aid; aid = aid->next) {
2680  if (aid->goto_id == l2->id) {
2681  break;
2682  }
2683  }
2684  if (!aid) {
2685  aid = cobc_parse_malloc (sizeof(struct cb_alter_id));
2686  aid->next = l1->alter_gotos;
2687  aid->goto_id = l2->id;
2688  l1->alter_gotos = aid;
2689  }
2690  for (aid = prog->alter_gotos; aid; aid = aid->next) {
2691  if (aid->goto_id == l1->id) {
2692  break;
2693  }
2694  }
2695  if (!aid) {
2696  aid = cobc_parse_malloc (sizeof(struct cb_alter_id));
2697  aid->next = prog->alter_gotos;
2698  aid->goto_id = l1->id;
2699  prog->alter_gotos = aid;
2700  }
2701  }
2702 
2703  current_section = save_section;
2704  current_paragraph = save_paragraph;
2705  cobc_cs_check = 0;
2706 
2707  prog->file_list = cb_list_reverse (prog->file_list);
2708  prog->exec_list = cb_list_reverse (prog->exec_list);
2709 }
const char * name
Definition: tree.h:645
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_LABEL(x)
Definition: tree.h:801
const char * name
Definition: tree.h:766
void * cobc_parse_malloc(const size_t size)
Definition: cobc.c:809
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
#define CB_FIELD_PTR(x)
Definition: tree.h:745
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
char * cb_name(cb_tree x)
Definition: tree.c:735
#define CB_LABEL_P(x)
Definition: tree.h:802
#define CB_PURPOSE(x)
Definition: tree.h:1192
unsigned int flag_debugging
Definition: tree.h:1320
#define CB_VALUE(x)
Definition: tree.h:1193
cb_tree cb_debug_item
Definition: typeck.c:82
strict implicit external value
Definition: warning.def:54
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
#define CB_CHAIN(x)
Definition: tree.h:1194
#define CB_TREE_TAG(x)
Definition: tree.h:441
#define CB_REFERENCE(x)
Definition: tree.h:901
struct cb_alter_id * next
Definition: tree.h:760
int size
Definition: tree.h:672
cb_tree cb_error_node
Definition: tree.c:140
struct cb_label * current_paragraph
Definition: parser.c:171
struct cb_program * current_program
Definition: parser.c:168
struct cb_alter_id * alter_gotos
Definition: tree.h:772
Definition: tree.h:764
cb_tree cb_debug_contents
Definition: typeck.c:88
struct cb_label * all_procedure
Definition: tree.h:1289
int memory_size
Definition: tree.h:674
int goto_id
Definition: tree.h:761
struct cb_label * current_section
Definition: parser.c:170
cb_tree cb_list_reverse(cb_tree l)
Definition: tree.c:1327
unsigned int cobc_cs_check
Definition: parser.c:182
int id
Definition: tree.h:773
#define CB_FIELD(x)
Definition: tree.h:740
unsigned int flag_first_is_goto
Definition: tree.h:793

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_program_data ( struct cb_program )

Definition at line 2344 of file typeck.c.

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_relative, cb_report::line_counter, cb_field::name, cb_report::name, NULL, cb_field::odo_level, 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.

Referenced by yyparse().

2345 {
2346  cb_tree l;
2347  cb_tree x;
2348  cb_tree assign;
2349  struct cb_field *p;
2350  struct cb_field *q;
2351  struct cb_field *depfld;
2352  struct cb_file *f;
2353  struct cb_report *rep;
2354  unsigned char *c;
2355  char buff[COB_MINI_BUFF];
2356  unsigned int odo_level;
2357 
2358  for (l = current_program->report_list; l; l = CB_CHAIN (l)) {
2359  /* Set up LINE-COUNTER / PAGE-COUNTER */
2360  rep = CB_REPORT (CB_VALUE (l));
2361  snprintf (buff, (size_t)COB_MINI_MAX,
2362  "LINE-COUNTER %s", rep->cname);
2363  x = cb_build_field (cb_build_reference (buff));
2364  CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
2365  CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
2366  CB_FIELD (x)->count++;
2370  snprintf (buff, (size_t)COB_MINI_MAX,
2371  "PAGE-COUNTER %s", rep->cname);
2372  x = cb_build_field (cb_build_reference (buff));
2373  CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
2374  CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
2375  CB_FIELD (x)->count++;
2379  }
2380 
2381  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2382  f = CB_FILE (CB_VALUE (l));
2383  if (!f->flag_finalized) {
2384  finalize_file (f, NULL);
2385  }
2386  }
2387 
2388  /* Build undeclared assignment name now */
2389  if (cb_assign_clause == CB_ASSIGN_MF) {
2390  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2391  assign = CB_FILE (CB_VALUE (l))->assign;
2392  if (!assign) {
2393  continue;
2394  }
2395  if (CB_REFERENCE_P (assign)) {
2396  for (x = current_program->file_list; x; x = CB_CHAIN (x)) {
2397  if (!strcmp (CB_FILE (CB_VALUE (x))->name,
2398  CB_NAME (assign))) {
2399  redefinition_error (assign);
2400  }
2401  }
2402  p = check_level_78 (CB_NAME (assign));
2403  if (p) {
2404  c = (unsigned char *)CB_LITERAL(CB_VALUE(p->values))->data;
2405  assign = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen ((char *)c)));
2406  CB_FILE (CB_VALUE (l))->assign = assign;
2407  }
2408  }
2409  if (CB_REFERENCE_P (assign) &&
2410  CB_WORD_COUNT (assign) == 0) {
2411  if (cb_warn_implicit_define) {
2412  cb_warning (_("'%s' will be implicitly defined"), CB_NAME (assign));
2413  }
2415  CB_FIELD (x)->count++;
2417  if (p) {
2418  while (p->sister) {
2419  p = p->sister;
2420  }
2421  p->sister = CB_FIELD (x);
2422  } else {
2424  }
2425  }
2426  if (CB_REFERENCE_P (assign)) {
2427  x = cb_ref (assign);
2428  if (CB_FIELD_P (x) && CB_FIELD (x)->level == 88) {
2429  cb_error_x (assign, _("ASSIGN data item '%s' invalid"), CB_NAME (assign));
2430  }
2431  }
2432  }
2433  }
2434 
2435  if (prog->cursor_pos) {
2436  x = cb_ref (prog->cursor_pos);
2437  if (x == cb_error_node) {
2438  prog->cursor_pos = NULL;
2439  } else if (CB_FIELD(x)->size != 6 && CB_FIELD(x)->size != 4) {
2440  cb_error_x (prog->cursor_pos, _("'%s' CURSOR is not 4 or 6 characters long"),
2441  cb_name (prog->cursor_pos));
2442  prog->cursor_pos = NULL;
2443  }
2444  }
2445  if (prog->crt_status) {
2446  x = cb_ref (prog->crt_status);
2447  if (x == cb_error_node) {
2448  prog->crt_status = NULL;
2449  } else if (CB_FIELD(x)->size != 4) {
2450  cb_error_x (prog->crt_status, _("'%s' CRT STATUS is not 4 characters long"),
2451  cb_name (prog->crt_status));
2452  prog->crt_status = NULL;
2453  }
2454  } else {
2455  l = cb_build_reference ("COB-CRT-STATUS");
2456  p = CB_FIELD (cb_build_field (l));
2457  p->usage = CB_USAGE_DISPLAY;
2458  p->pic = CB_PICTURE (cb_build_picture ("9(4)"));
2459  cb_validate_field (p);
2460  p->flag_no_init = 1;
2461  /* Do not initialize/bump ref count here
2462  p->values = CB_LIST_INIT (cb_zero);
2463  p->count++;
2464  */
2466  prog->crt_status = l;
2467  }
2468 
2469  /* Resolve all references so far */
2470  for (l = cb_list_reverse (prog->reference_list); l; l = CB_CHAIN (l)) {
2471  cb_ref (CB_VALUE (l));
2472  }
2473 
2474  /* Check ODO items */
2475  for (l = cb_depend_check; l; l = CB_CHAIN (l)) {
2476  x = CB_VALUE(l);
2477  if (x == cb_error_node) {
2478  continue;
2479  }
2480  q = CB_FIELD_PTR (x);
2481  if (cb_ref (q->depending) != cb_error_node) {
2482  depfld = CB_FIELD_PTR (q->depending);
2483  } else {
2484  depfld = NULL;
2485  }
2486  /* The data item that contains a OCCURS DEPENDING clause must be
2487  the last data item in the group */
2488  odo_level = 0;
2489  for (p = q; ; p = p->parent) {
2490  if (p->depending) odo_level++;
2491  p->odo_level = odo_level;
2492  if (!p->parent) {
2493  break;
2494  }
2495  for (; p->sister; p = p->sister) {
2496  if (p->sister == depfld) {
2497  cb_error_x (x,
2498  _("'%s' ODO field item invalid here"),
2499  p->sister->name);
2500  }
2501  if (!p->sister->redefines) {
2502  if (!cb_complex_odo) {
2503  cb_error_x (x,
2504  _("'%s' cannot have OCCURS DEPENDING"),
2505  cb_name (x));
2506  break;
2507  }
2508  p->flag_odo_relative = 1;
2509  }
2510  }
2511  }
2512 
2513  /* If the field is GLOBAL, then the ODO must also be GLOBAL */
2514  if (q->flag_is_global && depfld) {
2515  if (!depfld->flag_is_global) {
2516  cb_error_x (x, _("'%s' ODO item must have GLOBAL attribute"),
2517  depfld->name);
2518  }
2519  }
2520  }
2522  cb_needs_01 = 0;
2523 
2524  for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
2525  f = CB_FILE (CB_VALUE (l));
2526  if (CB_VALID_TREE(f->record_depending)) {
2527  x = f->record_depending;
2528  if (cb_ref (x) != cb_error_node) {
2529 #if 0 /* RXWRXW - This breaks old legacy programs */
2530  if (CB_REF_OR_FIELD_P(x)) {
2531  p = CB_FIELD_PTR (x);
2532  switch (p->storage) {
2533  case CB_STORAGE_WORKING:
2534  case CB_STORAGE_LOCAL:
2535  case CB_STORAGE_LINKAGE:
2536  break;
2537  default:
2538  cb_error (_("RECORD DEPENDING item must be in WORKING/LOCAL/LINKAGE section"));
2539  }
2540  } else {
2541 #endif
2542  if (!CB_REF_OR_FIELD_P(x)) {
2543  cb_error (_("Invalid RECORD DEPENDING item"));
2544  }
2545 #if 0 /* RXWRXW */
2546  }
2547 #endif
2548  }
2549  }
2550  }
2551 }
struct cb_literal * build_literal(const enum cb_category category, const void *data, const size_t size)
Definition: tree.c:722
const char * name
Definition: tree.h:645
cb_tree line_counter
Definition: tree.h:1215
#define CB_TREE(x)
Definition: tree.h:440
#define CB_REFERENCE_P(x)
Definition: tree.h:902
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
size_t cb_needs_01
Definition: field.c:37
unsigned int odo_level
Definition: tree.h:687
#define CB_VALID_TREE(x)
Definition: tree.h:445
cb_tree report_list
Definition: tree.h:1262
#define CB_FIELD_ADD(x, y)
Definition: tree.h:1856
struct cb_field * sister
Definition: tree.h:653
#define CB_LITERAL(x)
Definition: tree.h:601
cb_tree cb_build_implicit_field(cb_tree name, const int len)
Definition: tree.c:2175
#define CB_FIELD_PTR(x)
Definition: tree.h:745
unsigned int flag_odo_relative
Definition: tree.h:731
cb_tree cb_build_field_reference(struct cb_field *f, cb_tree ref)
Definition: tree.c:2604
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
char * cb_name(cb_tree x)
Definition: tree.c:735
cb_tree cb_build_field(cb_tree name)
Definition: tree.c:2159
struct cb_picture * pic
Definition: tree.h:659
#define COB_SMALL_BUFF
Definition: common.h:540
cb_tree cb_zero
Definition: tree.c:125
#define CB_PICTURE(x)
Definition: tree.h:631
#define COB_MINI_BUFF
Definition: common.h:539
char * cname
Definition: tree.h:1213
cb_tree file_list
Definition: tree.h:1252
unsigned char flag_is_global
Definition: tree.h:699
#define CB_FILE(x)
Definition: tree.h:858
cb_tree cb_build_picture(const char *str)
Definition: tree.c:1800
#define CB_VALUE(x)
Definition: tree.h:1193
cb_tree depending
Definition: tree.h:647
#define CB_FIELD_P(x)
Definition: tree.h:741
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
unsigned int flag_no_init
Definition: tree.h:727
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_NAME(x)
Definition: tree.h:904
cb_tree page_counter
Definition: tree.h:1216
void redefinition_error(cb_tree x)
Definition: error.c:284
Definition: tree.h:818
cb_tree cb_build_reference(const char *name)
Definition: tree.c:2572
void finalize_file(struct cb_file *f, struct cb_field *records)
Definition: tree.c:2409
cb_tree cb_error_node
Definition: tree.c:140
#define CB_ASSIGN_MF
Definition: cobc.h:77
struct cb_field * parent
Definition: tree.h:651
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
struct cb_program * current_program
Definition: parser.c:168
const char * name
Definition: tree.h:1212
#define CB_REPORT(x)
Definition: tree.h:1228
#define CB_WORD_COUNT(x)
Definition: tree.h:905
void cb_warning(const char *,...) COB_A_FORMAT12
Definition: error.c:87
#define CB_LIST_INIT(x)
Definition: tree.h:1851
struct cb_field * working_storage
Definition: tree.h:1276
cb_tree cb_depend_check
Definition: field.c:36
void cb_validate_field(struct cb_field *f)
Definition: field.c:1338
cb_tree cb_list_reverse(cb_tree l)
Definition: tree.c:1327
struct cb_field * redefines
Definition: tree.h:654
cb_tree values
Definition: tree.h:648
unsigned int flag_finalized
Definition: tree.h:849
#define CB_REF_OR_FIELD_P(x)
Definition: tree.h:743
struct cb_field * check_level_78(const char *name)
Definition: scanner.c:4858
enum cb_usage usage
Definition: tree.h:693
cb_tree record_depending
Definition: tree.h:830
enum cb_storage storage
Definition: tree.h:692
#define CB_FIELD(x)
Definition: tree.h:740
#define COB_MINI_MAX
Definition: common.h:545

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_program_environment ( struct cb_program )

Definition at line 1891 of file typeck.c.

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.

Referenced by yyparse().

1892 {
1893  cb_tree x;
1894  cb_tree y;
1895  cb_tree l;
1896  cb_tree ls;
1897  struct cb_alphabet_name *ap;
1898  struct cb_class_name *cp;
1899  unsigned char *data;
1900  size_t dupls;
1901  size_t unvals;
1902  size_t count;
1903  int lower;
1904  int upper;
1905  int size;
1906  int n;
1907  int i;
1908  int lastval;
1909  int tableval;
1910  int values[256];
1911  int charvals[256];
1912 
1913  /* Check ALPHABET clauses */
1914  /* Complicated by difference between code set and collating sequence */
1915  for (l = current_program->alphabet_name_list; l; l = CB_CHAIN (l)) {
1916  ap = CB_ALPHABET_NAME (CB_VALUE (l));
1917 
1918  /* Native */
1919  if (ap->alphabet_type == CB_ALPHABET_NATIVE) {
1920  for (n = 0; n < 256; n++) {
1921  ap->values[n] = n;
1922  ap->alphachr[n] = n;
1923  }
1924  continue;
1925  }
1926 
1927  /* ASCII */
1928  if (ap->alphabet_type == CB_ALPHABET_ASCII) {
1929  for (n = 0; n < 256; n++) {
1930 #ifdef COB_EBCDIC_MACHINE
1931  ap->values[n] = (int)cob_refer_ascii[n];
1932  ap->alphachr[n] = (int)cob_refer_ascii[n];
1933 #else
1934  ap->values[n] = n;
1935  ap->alphachr[n] = n;
1936 #endif
1937  }
1938  continue;
1939  }
1940 
1941  /* EBCDIC */
1942  if (ap->alphabet_type == CB_ALPHABET_EBCDIC) {
1943  for (n = 0; n < 256; n++) {
1944 #ifdef COB_EBCDIC_MACHINE
1945  ap->values[n] = n;
1946  ap->alphachr[n] = n;
1947 #else
1948  ap->values[n] = (int)cob_refer_ebcdic[n];
1949  ap->alphachr[n] = (int)cob_refer_ebcdic[n];
1950 #endif
1951  }
1952  continue;
1953  }
1954 
1955  /* Custom alphabet */
1956  dupls = 0;
1957  unvals = 0;
1958  count = 0;
1959  lastval = 0;
1960  tableval = 0;
1961  for (n = 0; n < 256; n++) {
1962  values[n] = -1;
1963  charvals[n] = -1;
1964  ap->values[n] = -1;
1965  ap->alphachr[n] = -1;
1966  }
1967  ap->low_val_char = 0;
1968  ap->high_val_char = 255;
1969  for (y = ap->custom_list; y; y = CB_CHAIN (y)) {
1970  if (count > 255) {
1971  unvals = 1;
1972  break;
1973  }
1974  x = CB_VALUE (y);
1975  if (CB_PAIR_P (x)) {
1976  /* X THRU Y */
1977  lower = get_value (CB_PAIR_X (x));
1978  upper = get_value (CB_PAIR_Y (x));
1979  lastval = upper;
1980  if (!count) {
1981  ap->low_val_char = lower;
1982  }
1983  if (lower < 0 || lower > 255) {
1984  unvals = 1;
1985  continue;
1986  }
1987  if (upper < 0 || upper > 255) {
1988  unvals = 1;
1989  continue;
1990  }
1991  if (lower <= upper) {
1992  for (i = lower; i <= upper; i++) {
1993  if (values[i] != -1) {
1994  dupls = 1;
1995  }
1996  values[i] = i;
1997  charvals[i] = i;
1998  ap->alphachr[tableval] = i;
1999  ap->values[i] = tableval++;
2000  count++;
2001  }
2002  } else {
2003  for (i = lower; i >= upper; i--) {
2004  if (values[i] != -1) {
2005  dupls = 1;
2006  }
2007  values[i] = i;
2008  charvals[i] = i;
2009  ap->alphachr[tableval] = i;
2010  ap->values[i] = tableval++;
2011  count++;
2012  }
2013  }
2014  } else if (CB_LIST_P (x)) {
2015  /* X ALSO Y ... */
2016  if (!count) {
2017  ap->low_val_char = get_value (CB_VALUE (x));
2018  }
2019  for (ls = x; ls; ls = CB_CHAIN (ls)) {
2020  n = get_value (CB_VALUE (ls));
2021  if (!CB_CHAIN (ls)) {
2022  lastval = n;
2023  }
2024  if (n < 0 || n > 255) {
2025  unvals = 1;
2026  continue;
2027  }
2028  if (values[n] != -1) {
2029  dupls = 1;
2030  }
2031  values[n] = n;
2032  ap->values[n] = tableval;
2033  if (ls == x) {
2034  ap->alphachr[tableval] = n;
2035  charvals[n] = n;
2036  }
2037  count++;
2038  }
2039  tableval++;
2040  } else {
2041  /* Literal */
2042  if (CB_NUMERIC_LITERAL_P (x)) {
2043  n = get_value (x);
2044  lastval = n;
2045  if (!count) {
2046  ap->low_val_char = n;
2047  }
2048  if (n < 0 || n > 255) {
2049  unvals = 1;
2050  continue;
2051  }
2052  if (values[n] != -1) {
2053  dupls = 1;
2054  }
2055  values[n] = n;
2056  charvals[n] = n;
2057  ap->alphachr[tableval] = n;
2058  ap->values[n] = tableval++;
2059  count++;
2060  } else if (CB_LITERAL_P (x)) {
2061  size = (int)CB_LITERAL (x)->size;
2062  data = CB_LITERAL (x)->data;
2063  if (!count) {
2064  ap->low_val_char = data[0];
2065  }
2066  lastval = data[size - 1];
2067  for (i = 0; i < size; i++) {
2068  n = data[i];
2069  if (values[n] != -1) {
2070  dupls = 1;
2071  }
2072  values[n] = n;
2073  charvals[n] = n;
2074  ap->alphachr[tableval] = n;
2075  ap->values[n] = tableval++;
2076  count++;
2077  }
2078  } else {
2079  n = get_value (x);
2080  lastval = n;
2081  if (!count) {
2082  ap->low_val_char = n;
2083  }
2084  if (n < 0 || n > 255) {
2085  unvals = 1;
2086  continue;
2087  }
2088  if (values[n] != -1) {
2089  dupls = 1;
2090  }
2091  values[n] = n;
2092  charvals[n] = n;
2093  ap->alphachr[tableval] = n;
2094  ap->values[n] = tableval++;
2095  count++;
2096  }
2097  }
2098  }
2099  if (dupls || unvals) {
2100  if (dupls) {
2101  cb_error_x (l, _("Duplicate character values in alphabet '%s'"),
2102  cb_name (CB_VALUE(l)));
2103  }
2104  if (unvals) {
2105  cb_error_x (l, _("Invalid character values in alphabet '%s'"),
2106  cb_name (CB_VALUE(l)));
2107  }
2108  ap->low_val_char = 0;
2109  ap->high_val_char = 255;
2110  continue;
2111  }
2112  /* Calculate HIGH-VALUE */
2113  /* If all 256 values have been specified, */
2114  /* HIGH-VALUE is the last one */
2115  /* Otherwise if HIGH-VALUE has been specified, find the highest */
2116  /* value that has not been used */
2117  if (count == 256) {
2118  ap->high_val_char = lastval;
2119  } else if (values[255] != -1) {
2120  for (n = 254; n >= 0; n--) {
2121  if (values[n] == -1) {
2122  ap->high_val_char = n;
2123  break;
2124  }
2125  }
2126  }
2127 
2128  /* Get rest of code set */
2129  for (n = tableval; n < 256; ++n) {
2130  for (i = 0; i < 256; ++i) {
2131  if (charvals[i] < 0) {
2132  charvals[i] = 0;
2133  ap->alphachr[n] = i;
2134  break;
2135  }
2136  }
2137  }
2138 
2139  /* Fill in missing characters */
2140  for (n = 0; n < 256; n++) {
2141  if (ap->values[n] < 0) {
2142  ap->values[n] = tableval++;
2143  }
2144  }
2145  }
2146 
2147  /* Reset HIGH/LOW-VALUES */
2148  cb_low = cb_norm_low;
2150 
2151  /* Check and generate SYMBOLIC clauses */
2152  for (l = current_program->symbolic_char_list; l; l = CB_CHAIN (l)) {
2153  if (CB_VALUE (l)) {
2154  y = cb_ref (CB_VALUE (l));
2155  if (y == cb_error_node) {
2156  continue;
2157  }
2158  if (!CB_ALPHABET_NAME_P (y)) {
2159  cb_error_x (y, _("Invalid ALPHABET name"));
2160  continue;
2161  }
2162  } else {
2163  y = NULL;
2164  }
2166  }
2167 
2168  /* Check CLASS clauses */
2169  for (l = current_program->class_name_list; l; l = CB_CHAIN (l)) {
2170  dupls = 0;
2171  memset (values, 0, sizeof(values));
2172  cp = CB_CLASS_NAME (CB_VALUE (l));
2173  for (y = cp->list; y; y = CB_CHAIN (y)) {
2174  x = CB_VALUE (y);
2175  if (CB_PAIR_P (x)) {
2176  /* X THRU Y */
2177  lower = get_value (CB_PAIR_X (x));
2178  upper = get_value (CB_PAIR_Y (x));
2179  for (i = lower; i <= upper; i++) {
2180  if (values[i]) {
2181  dupls = 1;
2182  }
2183  values[i] = 1;
2184  }
2185  } else {
2186  if (CB_NUMERIC_LITERAL_P (x)) {
2187  n = get_value (x);
2188  if (values[n]) {
2189  dupls = 1;
2190  }
2191  values[n] = 1;
2192  } else if (CB_LITERAL_P (x)) {
2193  size = (int)CB_LITERAL (x)->size;
2194  data = CB_LITERAL (x)->data;
2195  for (i = 0; i < size; i++) {
2196  n = data[i];
2197  if (values[n]) {
2198  dupls = 1;
2199  }
2200  values[n] = 1;
2201  }
2202  } else {
2203  n = get_value (x);
2204  if (values[n]) {
2205  dupls = 1;
2206  }
2207  values[n] = 1;
2208  }
2209  }
2210  }
2211  if (dupls) {
2212  if (!cb_relaxed_syntax_check) {
2213  cb_error_x (CB_VALUE(l),
2214  _("Duplicate values in class '%s'"),
2215  cb_name (CB_VALUE(l)));
2216  } else {
2217  cb_warning_x (CB_VALUE(l),
2218  _("Duplicate values in class '%s'"),
2219  cb_name (CB_VALUE(l)));
2220  }
2221  }
2222  }
2223 
2224  /* Resolve the program collating sequence */
2225  if (prog->collating_sequence) {
2226  cb_validate_collating (prog);
2227  }
2228 
2229  /* Resolve the program classification */
2230  if (prog->classification && prog->classification != cb_int1) {
2231  x = cb_ref (prog->classification);
2232  if (!CB_LOCALE_NAME_P (x)) {
2233  cb_error_x (prog->classification,
2234  _("'%s' is not a locale name"),
2235  cb_name (prog->classification));
2236  prog->classification = NULL;
2237  return;
2238  }
2239  }
2240 }
#define CB_NUMERIC_LITERAL_P(x)
Definition: tree.h:603
#define CB_PAIR_X(x)
Definition: tree.h:1205
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
cb_tree cb_int1
Definition: tree.c:134
#define CB_PAIR_P(x)
Definition: tree.h:1204
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
cb_tree cb_norm_high
Definition: tree.c:131
#define CB_LITERAL(x)
Definition: tree.h:601
static const unsigned char cob_refer_ebcdic[256]
Definition: typeck.c:242
cb_tree cb_norm_low
Definition: tree.c:130
cb_tree cb_ref(cb_tree x)
Definition: tree.c:2653
char * cb_name(cb_tree x)
Definition: tree.c:735
#define CB_PAIR_Y(x)
Definition: tree.h:1206
#define CB_ALPHABET_ASCII
Definition: tree.h:108
void cb_build_symbolic_chars(const cb_tree sym_list, const cb_tree alphabet)
Definition: tree.c:2289
#define CB_ALPHABET_NATIVE
Definition: tree.h:107
#define CB_PURPOSE(x)
Definition: tree.h:1192
static int get_value(cb_tree x)
Definition: typeck.c:1843
#define CB_LITERAL_P(x)
Definition: tree.h:602
#define CB_VALUE(x)
Definition: tree.h:1193
int alphachr[256]
Definition: tree.h:547
#define CB_ALPHABET_NAME(x)
Definition: tree.h:550
#define _(s)
Definition: cobcrun.c:59
int high_val_char
Definition: tree.h:545
#define CB_CHAIN(x)
Definition: tree.h:1194
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
cb_tree alphabet_name_list
Definition: tree.h:1256
int values[256]
Definition: tree.h:546
#define CB_LOCALE_NAME_P(x)
Definition: tree.h:575
cb_tree cb_error_node
Definition: tree.c:140
cb_tree class_name_list
Definition: tree.h:1258
#define CB_LIST_P(x)
Definition: tree.h:1190
struct cb_program * current_program
Definition: parser.c:168
int low_val_char
Definition: tree.h:544
static void cb_validate_collating(struct cb_program *prog)
Definition: typeck.c:1864
cb_tree cb_high
Definition: tree.c:129
#define CB_ALPHABET_NAME_P(x)
Definition: tree.h:551
#define CB_CLASS_NAME(x)
Definition: tree.h:562
unsigned int alphabet_type
Definition: tree.h:543
#define CB_ALPHABET_EBCDIC
Definition: tree.h:109
static const unsigned char cob_refer_ascii[256]
Definition: typeck.c:206
cb_tree cb_low
Definition: tree.c:128
cb_tree symbolic_char_list
Definition: tree.h:1257
cb_tree custom_list
Definition: tree.h:542
cb_tree list
Definition: tree.h:559

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 222 of file error.c.

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_for_duplicate_prototype(), check_picture_item(), check_prototype_redefines_current_func(), check_prototype_seen(), compute_size(), move_warning(), redefinition_warning(), terminator_warning(), undefined_error(), valid_const_date_time_args(), validate_field_1(), validate_move(), warn_cannot_get_utc(), warning_destination(), and yyparse().

223 {
224  va_list ap;
225 
226  va_start (ap, fmt);
227  print_error (x->source_file, x->source_line, _("Warning: "), fmt, ap);
228  va_end (ap);
229  warningcount++;
230 }
int warningcount
Definition: cobc.c:174
#define _(s)
Definition: cobcrun.c:59
static void print_error(const char *file, int line, const char *prefix, const char *fmt, va_list ap)
Definition: error.c:46

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_field* check_level_78 ( const char *  )

Definition at line 4858 of file scanner.c.

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

Referenced by cb_validate_program_data().

4859 {
4860  const struct cb_level_78 *p78;
4861 
4862  /* Check against a current constant (78 level) */
4863  for (p78 = lev78ptr; p78; p78 = p78->next) {
4864  if (strcasecmp (name, p78->fld78->name) == 0) {
4865  return p78->fld78;
4866  }
4867  }
4868  /* Check against a global constant (78 level) */
4869  for (p78 = globlev78ptr; p78; p78 = p78->next) {
4870  if (strcasecmp (name, p78->fld78->name) == 0) {
4871  return p78->fld78;
4872  }
4873  }
4874  return NULL;
4875 }
const char * name
Definition: tree.h:645
static struct cb_level_78 * globlev78ptr
Definition: scanner.c:1439
struct cb_field * fld78
Definition: scanner.c:1421
struct cb_level_78 * next
Definition: scanner.c:1418
static struct cb_level_78 * lev78ptr
Definition: scanner.c:1438
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the caller graph for this function:

DECLNORET void cobc_tree_cast_error ( const cb_tree  ,
const char *  ,
const int  ,
const enum  cb_tag 
)

Definition at line 619 of file cobc.c.

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));
628 }
static const char * cobc_enum_explain(const enum cb_tag tag)
Definition: cobc.c:503
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
char * cb_name(cb_tree x)
Definition: tree.c:735
#define _(s)
Definition: cobcrun.c:59
#define CB_TREE_TAG(x)
Definition: tree.h:441
static DECLNORET void COB_A_NORETURN cobc_abort_terminate(void)
Definition: cobc.c:1486
Definition: cobc.h:195

Here is the call graph for this function:

void codegen ( struct cb_program ,
const int   
)

Definition at line 7448 of file codegen.c.

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, 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().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void finalize_file ( struct cb_file ,
struct cb_field  
)

Definition at line 2409 of file tree.c.

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

Referenced by cb_validate_program_data(), and yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void group_error ( cb_tree  ,
const char *   
)

Definition at line 398 of file error.c.

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

Referenced by validate_field_1().

399 {
400  cb_error_x (x, _("Group item '%s' cannot have %s clause"),
401  cb_name (x), clause);
402 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
char * cb_name(cb_tree x)
Definition: tree.c:735
#define _(s)
Definition: cobcrun.c:59

Here is the call graph for this function:

Here is the caller graph for this function:

void level_except_error ( cb_tree  ,
const char *   
)

Definition at line 441 of file error.c.

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

442 {
443  const char *s;
444  const struct cb_field *f;
445 
446  s = cb_name (x);
447  f = CB_FIELD_PTR (x);
448  if (f->flag_item_78) {
449  cb_error_x (x, _("Constant item '%s' can only have a %s clause"),
450  s, clause);
451  } else {
452  cb_error_x (x, _("Level %02d item '%s' can only have a %s clause"),
453  f->level,
454  s, clause);
455  }
456 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_FIELD_PTR(x)
Definition: tree.h:745
char * cb_name(cb_tree x)
Definition: tree.c:735
int level
Definition: tree.h:673
unsigned int flag_item_78
Definition: tree.h:711
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643

Here is the call graph for this function:

Here is the caller graph for this function:

void level_redundant_error ( cb_tree  ,
const char *   
)

Definition at line 405 of file error.c.

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

Referenced by validate_field_1().

406 {
407  const char *s;
408  const struct cb_field *f;
409 
410  s = cb_name (x);
411  f = CB_FIELD_PTR (x);
412  if (f->flag_item_78) {
413  cb_error_x (x, _("Constant item '%s' cannot have a %s clause"),
414  s, clause);
415  } else {
416  cb_error_x (x, _("Level %02d item '%s' cannot have a %s clause"),
417  f->level,
418  s, clause);
419  }
420 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_FIELD_PTR(x)
Definition: tree.h:745
char * cb_name(cb_tree x)
Definition: tree.c:735
int level
Definition: tree.h:673
unsigned int flag_item_78
Definition: tree.h:711
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643

Here is the call graph for this function:

Here is the caller graph for this function:

void level_require_error ( cb_tree  ,
const char *   
)

Definition at line 423 of file error.c.

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

424 {
425  const char *s;
426  const struct cb_field *f;
427 
428  s = cb_name (x);
429  f = CB_FIELD_PTR (x);
430  if (f->flag_item_78) {
431  cb_error_x (x, _("Constant item '%s' requires a %s clause"),
432  s, clause);
433  } else {
434  cb_error_x (x, _("Level %02d item '%s' requires a %s clause"),
435  f->level,
436  s, clause);
437  }
438 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_FIELD_PTR(x)
Definition: tree.h:745
char * cb_name(cb_tree x)
Definition: tree.c:735
int level
Definition: tree.h:673
unsigned int flag_item_78
Definition: tree.h:711
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643

Here is the call graph for this function:

Here is the caller graph for this function:

struct cb_intrinsic_table* lookup_intrinsic ( const char *  ,
const int  ,
const int   
)

Definition at line 2976 of file reserved.c.

References cb_intrinsic_table::implemented, intrinsic_comp(), NULL, and NUM_INTRINSICS.

Referenced by cb_build_any_intrinsic(), cb_build_intrinsic(), cobc_deciph_funcs(), and yylex().

2977 {
2978  struct cb_intrinsic_table *cbp;
2979 
2980  cbp = bsearch (name, function_list, NUM_INTRINSICS,
2981  sizeof (struct cb_intrinsic_table), intrinsic_comp);
2982  if (cbp && (checkimpl || cbp->implemented)) {
2983  return cbp;
2984  }
2985  return NULL;
2986 }
const char * name
Definition: tree.h:979
const int implemented
Definition: tree.h:983
#define NUM_INTRINSICS
Definition: reserved.c:2490
static int intrinsic_comp(const void *p1, const void *p2)
Definition: reserved.c:2571
static const struct cb_intrinsic_table function_list[]
Definition: reserved.c:1965
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95

Here is the call graph for this function:

Here is the caller graph for this function:

struct cobc_reserved* lookup_reserved_word ( const char *  )

Definition at line 2910 of file reserved.c.

References _, CB_CS_PROGRAM_ID, cb_error(), cobc_cs_check, cobc_force_literal, cobc_in_procedure, cobc_in_repository, cobc_reserved::context_sens, cobc_reserved::context_set, cobc_reserved::context_test, create_dummy_reserved(), FUNCTION_ID, initialize_reserved_words_if_needed(), INTRINSIC, NULL, num_reserved_words, PROGRAM_ID, REPOSITORY, reserve_comp(), cobc_reserved::token, and unlikely.

Referenced by yylex().

2911 {
2912  struct cobc_reserved *p;
2913  struct cobc_reserved to_find;
2914 
2916 
2917  to_find = create_dummy_reserved (name);
2918  p = bsearch (&to_find, reserved_words, num_reserved_words,
2919  sizeof (struct cobc_reserved), reserve_comp);
2920  if (!p) {
2921  return NULL;
2922  }
2923 
2924  /* Check word is implemented */
2925  if (unlikely(p->token <= 0)) {
2926  /* Not implemented - If context sensitive, no error */
2927  if (!p->context_sens) {
2928  cb_error (_("'%s' reserved word, but not supported"), name);
2929  }
2930  return NULL;
2931  }
2932 
2933  /* Special actions / Context sensitive */
2934  if (p->context_set) {
2935  if (unlikely(p->context_test)) {
2936  /* Dependent words */
2937  if (!(cobc_cs_check & p->context_test)) {
2938  return p;
2939  }
2940  }
2941  cobc_cs_check |= p->context_set;
2942  return p;
2943  }
2944 
2945  if (p->context_test) {
2946 #if 0 /* RXWRXW - CS check */
2947  if (!(cobc_cs_check & p->context_test)) {
2948 #endif
2949  if ((cobc_cs_check & p->context_test) != p->context_test) {
2950  return NULL;
2951  }
2952  if (!cobc_in_procedure) {
2953  cobc_cs_check = 0;
2954  }
2955  return p;
2956  }
2957 
2958  if (p->token == FUNCTION_ID) {
2959  cobc_cs_check = 0;
2960  cobc_force_literal = 1;
2961  } else if (p->token == INTRINSIC) {
2962  if (!cobc_in_repository) {
2963  return NULL;
2964  }
2965  } else if (p->token == PROGRAM_ID) {
2967  cobc_force_literal = 1;
2968  } else if (p->token == REPOSITORY) {
2969  cobc_in_repository = 1;
2970  }
2971 
2972  return p;
2973 }
unsigned int cobc_force_literal
Definition: parser.c:181
static size_t num_reserved_words
Definition: reserved.c:1953
unsigned short context_sens
Definition: tree.h:420
static void initialize_reserved_words_if_needed(void)
Definition: reserved.c:2846
static struct cobc_reserved * reserved_words
Definition: reserved.c:198
static int reserve_comp(const void *p1, const void *p2)
Definition: reserved.c:2564
unsigned int context_set
Definition: tree.h:422
unsigned int cobc_in_repository
Definition: parser.c:180
#define _(s)
Definition: cobcrun.c:59
#define unlikely(x)
Definition: common.h:437
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
void cb_error(const char *,...) COB_A_FORMAT12
Definition: error.c:98
static struct cobc_reserved create_dummy_reserved(const char *word)
Definition: reserved.c:2599
unsigned int cobc_in_procedure
Definition: parser.c:179
int token
Definition: tree.h:421
const char * name
Definition: tree.h:418
unsigned int cobc_cs_check
Definition: parser.c:182
#define CB_CS_PROGRAM_ID
Definition: cobc.h:114
unsigned int context_test
Definition: tree.h:423

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree lookup_system_name ( const char *  )

Definition at line 2860 of file reserved.c.

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

Referenced by cb_build_display_name(), cb_define_system_name(), cb_emit_accept_name(), and yyparse().

2861 {
2862  size_t i;
2863 
2864  for (i = 0; i < SYSTEM_TAB_SIZE; ++i) {
2865  if (cob_strcasecmp (name, system_table[i].name) == 0) {
2866  return cb_build_system_name (system_table[i].category,
2867  system_table[i].token);
2868  }
2869  }
2870  if (cb_flag_syntax_extension) {
2871  for (i = 0; i < EXT_SYSTEM_TAB_SIZE; ++i) {
2872  if (cob_strcasecmp (name, ext_system_table[i].name) == 0) {
2873  return cb_build_system_name (ext_system_table[i].category,
2874  ext_system_table[i].token);
2875  }
2876  }
2877  }
2878  return NULL;
2879 }
#define SYSTEM_TAB_SIZE
Definition: reserved.c:114
#define EXT_SYSTEM_TAB_SIZE
Definition: reserved.c:188
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static int cob_strcasecmp(const void *s1, const void *s2)
Definition: reserved.c:2530
int token
Definition: tree.h:421
const char * name
Definition: tree.h:418
static const struct system_struct ext_system_table[]
Definition: reserved.c:116
cb_tree cb_build_system_name(const enum cb_system_name_category category, const int token)
Definition: tree.c:1667

Here is the call graph for this function:

Here is the caller graph for this function:

void redefinition_error ( cb_tree  )

Definition at line 284 of file error.c.

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

Referenced by cb_build_section_name(), cb_validate_program_data(), check_for_duplicate_prototype(), and yyparse().

285 {
286  struct cb_word *w;
287 
288  w = CB_REFERENCE (x)->word;
289  cb_error_x (x, _("Redefinition of '%s'"), w->name);
290  if (w->items) {
291  cb_error_x (CB_VALUE (w->items),
292  _("'%s' previously defined here"), w->name);
293  }
294 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_VALUE(x)
Definition: tree.h:1193
const char * name
Definition: tree.h:865
#define _(s)
Definition: cobcrun.c:59
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree items
Definition: tree.h:866
Definition: tree.h:863

Here is the call graph for this function:

Here is the caller graph for this function:

void redefinition_warning ( cb_tree  ,
cb_tree   
)

Definition at line 297 of file error.c.

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

Referenced by cb_build_field_tree().

298 {
299  struct cb_word *w;
300  cb_tree z;
301 
302  w = CB_REFERENCE (x)->word;
303  cb_warning_x (x, _("Redefinition of '%s'"), w->name);
304  z = NULL;
305  if (y) {
306  z = y;
307  } else if (w->items) {
308  z = CB_VALUE (w->items);
309  }
310 
311  if (z) {
312  cb_warning_x (z, _("'%s' previously defined here"), w->name);
313  }
314 }
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
#define CB_VALUE(x)
Definition: tree.h:1193
const char * name
Definition: tree.h:865
#define _(s)
Definition: cobcrun.c:59
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
#define CB_REFERENCE(x)
Definition: tree.h:901
cb_tree items
Definition: tree.h:866
Definition: tree.h:863

Here is the call graph for this function:

Here is the caller graph for this function:

void undefined_error ( cb_tree  )

Definition at line 317 of file error.c.

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

318 {
319  struct cb_reference *r;
320  cb_tree c;
321 
322  if (!errnamebuff) {
324  }
325  r = CB_REFERENCE (x);
326  snprintf (errnamebuff, (size_t)COB_NORMAL_MAX, "'%s'", CB_NAME (x));
328  for (c = r->chain; c; c = CB_REFERENCE (c)->chain) {
329  strcat (errnamebuff, " in '");
330  strcat (errnamebuff, CB_NAME (c));
331  strcat (errnamebuff, "'");
332  }
333  if (r->flag_optional) {
334  cb_warning_x (x, _("%s is not defined"), errnamebuff);
335  } else {
336  cb_error_x (x, _("%s is not defined"), errnamebuff);
337  }
338 }
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
void * cobc_main_malloc(const size_t size)
Definition: cobc.c:702
unsigned int flag_optional
Definition: tree.h:896
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
#define COB_NORMAL_BUFF
Definition: common.h:541
cb_tree chain
Definition: tree.h:875
#define _(s)
Definition: cobcrun.c:59
#define CB_NAME(x)
Definition: tree.h:904
#define CB_REFERENCE(x)
Definition: tree.h:901
#define COB_NORMAL_MAX
Definition: common.h:547
static char * errnamebuff
Definition: error.c:34

Here is the call graph for this function:

Here is the caller graph for this function:

void validate_file ( struct cb_file ,
cb_tree   
)

Definition at line 2360 of file tree.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

int validate_move ( cb_tree  ,
cb_tree  ,
const unsigned  int 
)

Definition at line 6167 of file typeck.c.

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, 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.

Referenced by cb_build_move(), and validate_field_value().

6168 {
6169  struct cb_field *fdst;
6170  struct cb_field *fsrc;
6171  struct cb_literal *l;
6172  unsigned char *p;
6173  cb_tree loc;
6174  cob_s64_t val;
6175  size_t i;
6176  size_t is_numeric_edited;
6177  int src_scale_mod;
6178  int dst_scale_mod;
6179  int dst_size_mod;
6180  int size;
6181  int most_significant;
6182  int least_significant;
6183 
6184  loc = src->source_line ? src : dst;
6185  is_numeric_edited = 0;
6186  overlapping = 0;
6187  if (CB_REFERENCE_P (dst)) {
6188  if (CB_ALPHABET_NAME_P(CB_REFERENCE(dst)->value)) {
6189  goto invalid;
6190  }
6191  if (CB_FILE_P(CB_REFERENCE(dst)->value)) {
6192  goto invalid;
6193  }
6194  }
6195  if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN) {
6196  cb_error_x (loc, _("Invalid destination for MOVE"));
6197  return -1;
6198  }
6199 
6200  if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) {
6201  if (CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
6202  return 0;
6203  } else {
6204  goto invalid;
6205  }
6206  }
6207 
6208  fdst = CB_FIELD_PTR (dst);
6209  switch (CB_TREE_TAG (src)) {
6210  case CB_TAG_CONST:
6211  if (src == cb_space) {
6212  if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
6213  (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && !is_value)) {
6214  if (!cb_relaxed_syntax_check || is_value) {
6215  goto invalid;
6216  }
6217  cb_warning_x (loc, _("Source is non-numeric - substituting zero"));
6218  }
6219  } else if (src == cb_zero) {
6221  goto invalid;
6222  }
6223  } else if (src == cb_low || src == cb_high || src == cb_quote) {
6224  if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
6226  if (!cb_relaxed_syntax_check || is_value) {
6227  goto invalid;
6228  }
6229  cb_warning_x (loc, _("Source is non-numeric - substituting zero"));
6230  }
6231  }
6232  break;
6233  case CB_TAG_LITERAL:
6234  l = CB_LITERAL (src);
6235  if (CB_TREE_CLASS (src) == CB_CLASS_NUMERIC) {
6236  /* Numeric literal */
6237  if (l->all) {
6238  goto invalid;
6239  }
6240  if (fdst->usage == CB_USAGE_DOUBLE ||
6241  fdst->usage == CB_USAGE_FLOAT ||
6242  fdst->usage == CB_USAGE_LONG_DOUBLE ||
6243  fdst->usage == CB_USAGE_FP_BIN32 ||
6244  fdst->usage == CB_USAGE_FP_BIN64 ||
6245  fdst->usage == CB_USAGE_FP_BIN128 ||
6246  fdst->usage == CB_USAGE_FP_DEC64 ||
6247  fdst->usage == CB_USAGE_FP_DEC128) {
6248  break;
6249  }
6250  most_significant = -999;
6251  least_significant = 999;
6252 
6253  /* Compute the most significant figure place */
6254  for (i = 0; i < l->size; i++) {
6255  if (l->data[i] != '0') {
6256  break;
6257  }
6258  }
6259  if (i != l->size) {
6260  most_significant = (int) (l->size - l->scale - i - 1);
6261  }
6262 
6263  /* Compute the least significant figure place */
6264  for (i = 0; i < l->size; i++) {
6265  if (l->data[l->size - i - 1] != '0') {
6266  break;
6267  }
6268  }
6269  if (i != l->size) {
6270  least_significant = (int) (-l->scale + i);
6271  }
6272 
6273  /* Value check */
6274  switch (CB_TREE_CATEGORY (dst)) {
6277  if (is_value) {
6278  goto expect_alphanumeric;
6279  }
6280  if (l->scale == 0) {
6281  goto expect_alphanumeric;
6282  }
6283  goto non_integer_move;
6284  case CB_CATEGORY_NUMERIC:
6285  if (fdst->pic->scale < 0) {
6286  /* Check for PIC 9(n)P(m) */
6287  if (least_significant < -fdst->pic->scale) {
6288  goto value_mismatch;
6289  }
6290  } else if (fdst->pic->scale > fdst->pic->size) {
6291  /* Check for PIC P(n)9(m) */
6292  if (most_significant >= fdst->pic->size - fdst->pic->scale) {
6293  goto value_mismatch;
6294  }
6295  }
6296  break;
6298  if (is_value) {
6299  goto expect_alphanumeric;
6300  }
6301 
6302  /* TODO */
6303  break;
6305  if (is_value) {
6306  goto expect_alphanumeric;
6307  }
6308  /* Coming from codegen */
6309  if (!suppress_warn) {
6310  goto invalid;
6311  }
6312 #if 1 /* RXWRXW - Initialize warn */
6313  if (warningopt) {
6314  cb_warning_x (loc, _("Numeric move to ALPHABETIC"));
6315  }
6316 #endif
6317  break;
6318  default:
6319  if (is_value) {
6320  goto expect_alphanumeric;
6321  }
6322  goto invalid;
6323  }
6324 
6325  /* Sign check */
6326  if (l->sign != 0 && !fdst->pic->have_sign) {
6327  if (is_value) {
6328  cb_error_x (loc, _("Data item not signed"));
6329  return -1;
6330  }
6331  if (cb_warn_constant) {
6332  cb_warning_x (loc, _("Ignoring sign"));
6333  }
6334  }
6335 
6336  /* Size check */
6337  if (fdst->flag_real_binary ||
6338  ((fdst->usage == CB_USAGE_COMP_5 ||
6339  fdst->usage == CB_USAGE_COMP_X ||
6340  fdst->usage == CB_USAGE_BINARY) &&
6341  fdst->pic->scale == 0)) {
6342  p = l->data;
6343  for (i = 0; i < l->size; i++) {
6344  if (l->data[i] != '0') {
6345  p = &l->data[i];
6346  break;
6347  }
6348  }
6349  i = l->size - i;
6350  switch (fdst->size) {
6351  case 1:
6352  if (i > 18) {
6353  goto numlit_overflow;
6354  }
6355  val = cb_get_long_long (src);
6356  if (fdst->pic->have_sign) {
6357  if (val < COB_S64_C(-128) ||
6358  val > COB_S64_C(127)) {
6359  goto numlit_overflow;
6360  }
6361  } else {
6362  if (val > COB_S64_C(255)) {
6363  goto numlit_overflow;
6364  }
6365  }
6366  break;
6367  case 2:
6368  if (i > 18) {
6369  goto numlit_overflow;
6370  }
6371  val = cb_get_long_long (src);
6372  if (fdst->pic->have_sign) {
6373  if (val < COB_S64_C(-32768) ||
6374  val > COB_S64_C(32767)) {
6375  goto numlit_overflow;
6376  }
6377  } else {
6378  if (val > COB_S64_C(65535)) {
6379  goto numlit_overflow;
6380  }
6381  }
6382  break;
6383  case 3:
6384  if (i > 18) {
6385  goto numlit_overflow;
6386  }
6387  val = cb_get_long_long (src);
6388  if (fdst->pic->have_sign) {
6389  if (val < COB_S64_C(-8388608) ||
6390  val > COB_S64_C(8388607)) {
6391  goto numlit_overflow;
6392  }
6393  } else {
6394  if (val > COB_S64_C(16777215)) {
6395  goto numlit_overflow;
6396  }
6397  }
6398  break;
6399  case 4:
6400  if (i > 18) {
6401  goto numlit_overflow;
6402  }
6403  val = cb_get_long_long (src);
6404  if (fdst->pic->have_sign) {
6405  if (val < COB_S64_C(-2147483648) ||
6406  val > COB_S64_C(2147483647)) {
6407  goto numlit_overflow;
6408  }
6409  } else {
6410  if (val > COB_S64_C(4294967295)) {
6411  goto numlit_overflow;
6412  }
6413  }
6414  break;
6415  case 5:
6416  if (i > 18) {
6417  goto numlit_overflow;
6418  }
6419  val = cb_get_long_long (src);
6420  if (fdst->pic->have_sign) {
6421  if (val < COB_S64_C(-549755813888) ||
6422  val > COB_S64_C(549755813887)) {
6423  goto numlit_overflow;
6424  }
6425  } else {
6426  if (val > COB_S64_C(1099511627775)) {
6427  goto numlit_overflow;
6428  }
6429  }
6430  break;
6431  case 6:
6432  if (i > 18) {
6433  goto numlit_overflow;
6434  }
6435  val = cb_get_long_long (src);
6436  if (fdst->pic->have_sign) {
6437  if (val < COB_S64_C(-140737488355328) ||
6438  val > COB_S64_C(140737488355327)) {
6439  goto numlit_overflow;
6440  }
6441  } else {
6442  if (val > COB_S64_C(281474976710655)) {
6443  goto numlit_overflow;
6444  }
6445  }
6446  break;
6447  case 7:
6448  if (i > 18) {
6449  goto numlit_overflow;
6450  }
6451  val = cb_get_long_long (src);
6452  if (fdst->pic->have_sign) {
6453  if (val < COB_S64_C(-36028797018963968) ||
6454  val > COB_S64_C(36028797018963967)) {
6455  goto numlit_overflow;
6456  }
6457  } else {
6458  if (val > COB_S64_C(72057594037927935)) {
6459  goto numlit_overflow;
6460  }
6461  }
6462  break;
6463  default:
6464  if (fdst->pic->have_sign) {
6465  if (i < 19) {
6466  break;
6467  }
6468  if (i > 19) {
6469  goto numlit_overflow;
6470  }
6471  if (memcmp (p, "9223372036854775807", (size_t)19) > 0) {
6472  goto numlit_overflow;
6473  }
6474  } else {
6475  if (i < 20) {
6476  break;
6477  }
6478  if (i > 20) {
6479  goto numlit_overflow;
6480  }
6481  if (memcmp (p, "18446744073709551615", (size_t)20) > 0) {
6482  goto numlit_overflow;
6483  }
6484  }
6485  break;
6486  }
6487  return 0;
6488  }
6489  if (least_significant < -fdst->pic->scale) {
6490  goto size_overflow;
6491  }
6492  if (fdst->pic->scale > 0) {
6493  size = fdst->pic->digits - fdst->pic->scale;
6494  } else {
6495  size = fdst->pic->digits;
6496  }
6497  if (most_significant >= size) {
6498  goto size_overflow;
6499  }
6500  } else {
6501  /* Alphanumeric literal */
6502 
6503  /* Value check */
6504  switch (CB_TREE_CATEGORY (dst)) {
6506  for (i = 0; i < l->size; i++) {
6507  if (!isalpha (l->data[i]) &&
6508  l->data[i] != ' ') {
6509  goto value_mismatch;
6510  }
6511  }
6512  break;
6513  case CB_CATEGORY_NUMERIC:
6514  goto expect_numeric;
6516  if (!is_value) {
6517  goto expect_numeric;
6518  }
6519 
6520  /* TODO: validate the value */
6521  break;
6522  default:
6523  break;
6524  }
6525 
6526  /* Size check */
6527  size = cb_field_size (dst);
6528  if (size > 0 && (int)l->size > size) {
6529  goto size_overflow;
6530  }
6531  }
6532  break;
6533  case CB_TAG_FIELD:
6534  case CB_TAG_REFERENCE:
6535  if (CB_REFERENCE_P(src) &&
6537  break;
6538  }
6539  if (CB_REFERENCE_P(src) &&
6540  CB_FILE_P(CB_REFERENCE(src)->value)) {
6541  goto invalid;
6542  }
6543  fsrc = CB_FIELD_PTR (src);
6544  size = cb_field_size (src);
6545  if (size < 0) {
6546  size = fsrc->size;
6547  }
6548 
6549  /* Check basic overlapping */
6550  overlapping = cb_check_overlapping (src, dst, fsrc, fdst);
6551 
6552  /* Non-elementary move */
6553  if (fsrc->children || fdst->children) {
6554  if (size > fdst->size) {
6555  goto size_overflow_1;
6556  }
6557  break;
6558  }
6559 
6560  /* Elementary move */
6561  switch (CB_TREE_CATEGORY (src)) {
6563  switch (CB_TREE_CATEGORY (dst)) {
6564  case CB_CATEGORY_NUMERIC:
6566  if (size > (int)fdst->pic->digits) {
6567  goto size_overflow_2;
6568  }
6569  break;
6571  if (size > count_pic_alphanumeric_edited (fdst)) {
6572  goto size_overflow_1;
6573  }
6574  break;
6575  default:
6576  if (size > fdst->size) {
6577  goto size_overflow_1;
6578  }
6579  break;
6580  }
6581  break;
6584  switch (CB_TREE_CATEGORY (dst)) {
6585  case CB_CATEGORY_NUMERIC:
6587  goto invalid;
6589  if (size > count_pic_alphanumeric_edited(fdst)) {
6590  goto size_overflow_1;
6591  }
6592  break;
6593  default:
6594  if (size > fdst->size) {
6595  goto size_overflow_1;
6596  }
6597  break;
6598  }
6599  break;
6600  case CB_CATEGORY_NUMERIC:
6602  switch (CB_TREE_CATEGORY (dst)) {
6604  goto invalid;
6606  is_numeric_edited = 1;
6607  /* Drop through */
6609  if (!fsrc->pic) {
6610  return -1;
6611  }
6612  if (is_numeric_edited) {
6613  dst_size_mod = count_pic_alphanumeric_edited (fdst);
6614  } else {
6615  dst_size_mod = fdst->size;
6616  }
6617  if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC &&
6618  fsrc->pic->scale > 0) {
6619  goto non_integer_move;
6620  }
6621  if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC &&
6622  (int)fsrc->pic->digits > dst_size_mod) {
6623  goto size_overflow_2;
6624  }
6626  fsrc->size > dst_size_mod) {
6627  goto size_overflow_1;
6628  }
6629  break;
6630  default:
6631  if (!fsrc->pic) {
6632  return -1;
6633  }
6634  if (!fdst->pic) {
6635  return -1;
6636  }
6637  src_scale_mod = fsrc->pic->scale < 0 ?
6638  0 : fsrc->pic->scale;
6639  dst_scale_mod = fdst->pic->scale < 0 ?
6640  0 : fdst->pic->scale;
6641  if (fsrc->pic->digits - src_scale_mod >
6642  fdst->pic->digits - dst_scale_mod ||
6643  src_scale_mod > dst_scale_mod) {
6644  goto size_overflow_2;
6645  }
6646  break;
6647  }
6648  break;
6649  default:
6650  cb_error_x (loc, _("Invalid source for MOVE"));
6651  return -1;
6652  }
6653  break;
6654  case CB_TAG_INTEGER:
6655  case CB_TAG_BINARY_OP:
6656  case CB_TAG_INTRINSIC:
6657  case CB_TAG_FUNCALL:
6658  /* TODO: check this */
6659  break;
6660  default:
6661  cobc_abort_pr (_("Unexpected tree tag %d"),
6662  (int)CB_TREE_TAG (src));
6663  COBC_ABORT ();
6664  }
6665  return 0;
6666 
6667 invalid:
6668  if (is_value) {
6669  cb_error_x (loc, _("Invalid VALUE clause"));
6670  } else {
6671  cb_error_x (loc, _("Invalid MOVE statement"));
6672  }
6673  return -1;
6674 
6675 numlit_overflow:
6676  if (is_value) {
6677  cb_error_x (loc, _("Invalid VALUE clause - literal exceeds data size"));
6678  return -1;
6679  }
6680  if (cb_warn_constant && !suppress_warn) {
6681  cb_warning_x (loc, _("Numeric literal exceeds data size"));
6682  }
6683  return 0;
6684 
6685 non_integer_move:
6686  if (cb_move_noninteger_to_alphanumeric == CB_ERROR) {
6687  goto invalid;
6688  }
6689  if (!suppress_warn) {
6690  cb_warning_x (loc, _("MOVE of non-integer to alphanumeric"));
6691  }
6692  return 0;
6693 
6694 expect_numeric:
6695  move_warning (src, dst, is_value, cb_warn_strict_typing, 0,
6696  _("Numeric value is expected"));
6697  return 0;
6698 
6699 expect_alphanumeric:
6700  move_warning (src, dst, is_value, cb_warn_strict_typing, 0,
6701  _("Alphanumeric value is expected"));
6702  return 0;
6703 
6704 value_mismatch:
6705  move_warning (src, dst, is_value, cb_warn_constant, 0,
6706  _("Value does not fit the picture string"));
6707  return 0;
6708 
6709 size_overflow:
6710  move_warning (src, dst, is_value, cb_warn_constant, 0,
6711  _("Value size exceeds data size"));
6712  return 0;
6713 
6714 size_overflow_1:
6715  move_warning (src, dst, is_value, cb_warn_truncate, 1,
6716  _("Sending field larger than receiving field"));
6717  return 0;
6718 
6719 size_overflow_2:
6720  move_warning (src, dst, is_value, cb_warn_truncate, 1,
6721  _("Some digits may be truncated"));
6722  return 0;
6723 }
unsigned int flag_real_binary
Definition: tree.h:708
#define CB_REFERENCE_P(x)
Definition: tree.h:902
static int cb_field_size(const cb_tree x)
Definition: typeck.c:790
void cb_error_x(cb_tree x, const char *fmt,...)
Definition: error.c:233
#define CB_TREE_CATEGORY(x)
Definition: tree.h:443
short sign
Definition: tree.h:597
void cobc_abort_pr(const char *fmt,...)
Definition: cobc.c:587
int size
Definition: tree.h:622
int scale
Definition: tree.h:626
void cb_warning_x(cb_tree x, const char *fmt,...)
Definition: error.c:222
static void move_warning(cb_tree src, cb_tree dst, const unsigned int value_flag, const int flag, const int src_flag, const char *msg)
Definition: typeck.c:6025
static int count_pic_alphanumeric_edited(struct cb_field *field)
Definition: typeck.c:6060
struct cb_field * children
Definition: tree.h:652
#define CB_LITERAL(x)
Definition: tree.h:601
Definition: cobc.h:141
#define CB_FIELD_PTR(x)
Definition: tree.h:745
int warningopt
Definition: cobc.c:176
struct cb_picture * pic
Definition: tree.h:659
cob_u32_t digits
Definition: tree.h:625
cb_tree cb_zero
Definition: tree.c:125
static size_t overlapping
Definition: typeck.c:103
cb_tree cb_quote
Definition: tree.c:132
cb_tree cb_space
Definition: tree.c:127
#define cob_s64_t
Definition: common.h:51
#define COB_S64_C(x)
Definition: common.h:54
short all
Definition: tree.h:598
#define CB_TREE_CLASS(x)
Definition: tree.h:442
static size_t cb_check_overlapping(cb_tree src, cb_tree dst, struct cb_field *src_f, struct cb_field *dst_f)
Definition: typeck.c:6078
strict implicit external value
Definition: warning.def:54
int source_line
Definition: tree.h:432
#define _(s)
Definition: cobcrun.c:59
Definition: tree.h:643
int scale
Definition: tree.h:595
#define CB_TREE_TAG(x)
Definition: tree.h:441
#define COBC_ABORT()
Definition: cobc.h:61
#define CB_REFERENCE(x)
Definition: tree.h:901
#define CB_FILE_P(x)
Definition: tree.h:859
int size
Definition: tree.h:672
unsigned char * data
Definition: tree.h:593
cob_u32_t have_sign
Definition: tree.h:627
cb_tree cb_high
Definition: tree.c:129
#define CB_ALPHABET_NAME_P(x)
Definition: tree.h:551
size_t suppress_warn
Definition: typeck.c:90
cob_s64_t cb_get_long_long(const cb_tree x)
Definition: tree.c:1175
cob_u32_t size
Definition: tree.h:594
enum cb_usage usage
Definition: tree.h:693
cb_tree cb_low
Definition: tree.c:128

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

cb_tree cb_any

Definition at line 121 of file tree.c.

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

cb_tree cb_debug_item

Definition at line 82 of file typeck.c.

cb_tree cb_debug_line

Definition at line 83 of file typeck.c.

Referenced by output_stmt().

cb_tree cb_debug_sub_1

Definition at line 85 of file typeck.c.

cb_tree cb_debug_sub_2

Definition at line 86 of file typeck.c.

cb_tree cb_debug_sub_3

Definition at line 87 of file typeck.c.

cb_tree cb_depend_check

Definition at line 36 of file field.c.

Referenced by cb_validate_program_data().

cb_tree cb_error_node

Definition at line 140 of file tree.c.

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

cb_tree cb_false

Definition at line 123 of file tree.c.

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

cb_tree cb_i[16]

Definition at line 139 of file tree.c.

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

cb_tree cb_int2

Definition at line 135 of file tree.c.

Referenced by cb_emit_read(), and yyparse().

cb_tree cb_int3

Definition at line 136 of file tree.c.

Referenced by cb_emit_read(), and yyparse().

cb_tree cb_int4

Definition at line 137 of file tree.c.

Referenced by cb_emit_read(), and yyparse().

cb_tree cb_int5

Definition at line 138 of file tree.c.

cb_tree cb_intr_whencomp

Definition at line 142 of file tree.c.

Referenced by cb_build_intrinsic(), and cb_build_registers().

size_t cb_needs_01

Definition at line 37 of file field.c.

Referenced by cb_build_field_tree(), cb_validate_program_data(), and yyparse().

cb_tree cb_one

Definition at line 126 of file tree.c.

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

cb_tree cb_standard_error_handler

Definition at line 144 of file tree.c.

Referenced by output_error_handler(), and output_section_info().

unsigned int cobc_cs_check
unsigned int cobc_force_literal

Definition at line 181 of file parser.c.

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

unsigned int cobc_in_procedure
unsigned int cobc_in_repository
cb_tree cobc_printer_node

Definition at line 176 of file parser.c.

unsigned int gen_screen_ptr

Definition at line 146 of file tree.c.

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

int non_const_word

Definition at line 178 of file parser.c.

Referenced by clear_initial_values(), yylex(), and yyparse().