#include "config.h"
#include <stdio.h>
#include <stdlib.h>
#include <stddef.h>
#include <string.h>
#include <ctype.h>
#include <time.h>
#include <limits.h>
#include "cobc.h"
#include "tree.h"
#include "libcob/system.def"

Include dependency graph for typeck.c:

Data Structures
struct	system_table

struct	optim_table

struct	expr_node

Macros
#define	START_STACK_SIZE 32

#define	TOKEN(offset) (expr_stack[expr_index + offset].token)

#define	VALUE(offset) (expr_stack[expr_index + offset].value)

#define	dpush(x) CB_ADD_TO_CHAIN (x, decimal_stack)

#define	cb_emit(x) current_statement->body = cb_list_add (current_statement->body, x)

#define	cb_emit_list(l) current_statement->body = cb_list_append (current_statement->body, l)

#define	COB_SYSTEM_GEN(x, y, z) { x, y },

Functions
static cb_tree	cb_check_needs_break (cb_tree stmt)

static size_t	cb_validate_one (cb_tree x)

static size_t	cb_validate_list (cb_tree l)

static cb_tree	cb_check_group_name (cb_tree x)

static cb_tree	cb_check_numeric_name (cb_tree x)

static cb_tree	cb_check_numeric_edited_name (cb_tree x)

cb_tree	cb_check_numeric_value (cb_tree x)

static cb_tree	cb_check_integer_value (cb_tree x)

static void	cb_check_data_incompat (cb_tree x)

static void	cb_check_lit_subs (struct cb_reference *r, const int numsubs, const int numindex)

static int	cb_field_size (const cb_tree x)

void	cb_list_system (void)

size_t	cb_check_index_p (cb_tree x)

void	cb_check_field_debug (cb_tree fld)

void	cb_build_registers (void)

char *	cb_encode_program_id (const char *name)

char *	cb_build_program_id (cb_tree name, cb_tree alt_name, const cob_u32_t is_func)

cb_tree	cb_define_switch_name (cb_tree name, cb_tree sname, const int flag)

cb_tree	cb_build_section_name (cb_tree name, const int sect_or_para)

cb_tree	cb_build_assignment_name (struct cb_file *cfile, cb_tree name)

cb_tree	cb_build_index (cb_tree x, cb_tree values, const unsigned int indexed_by, struct cb_field *qual)

cb_tree	cb_build_address (cb_tree x)

cb_tree	cb_build_identifier (cb_tree x, const int subchk)

static cb_tree	cb_build_length_1 (cb_tree x)

cb_tree	cb_build_const_length (cb_tree x)

cb_tree	cb_build_length (cb_tree x)

cb_tree	cb_build_ppointer (cb_tree x)

static int	get_value (cb_tree x)

static void	cb_validate_collating (struct cb_program *prog)

void	cb_validate_program_environment (struct cb_program *prog)

void	cb_build_debug_item (void)

void	cb_validate_program_data (struct cb_program *prog)

void	cb_validate_program_body (struct cb_program *prog)

static void	cb_expr_init (void)

static int	expr_chk_cond (cb_tree expr_1, cb_tree expr_2)

static int	expr_reduce (int token)

static void	cb_expr_shift_sign (const int op)

static void	cb_expr_shift_class (const char *name)

static void	cb_expr_shift (int token, cb_tree value)

static void	expr_expand (cb_tree *x)

static cb_tree	cb_expr_finish (void)

cb_tree	cb_build_expr (cb_tree list)

static cb_tree	build_store_option (cb_tree x, cb_tree round_opt)

static cb_tree	decimal_alloc (void)

static void	decimal_free (void)

static void	decimal_compute (const int op, cb_tree x, cb_tree y)

static void	decimal_expand (cb_tree d, cb_tree x)

static void	decimal_assign (cb_tree x, cb_tree d, cb_tree round_opt)

static cb_tree	cb_build_mul (cb_tree v, cb_tree n, cb_tree round_opt)

static cb_tree	cb_build_div (cb_tree v, cb_tree n, cb_tree round_opt)

static cb_tree	build_decimal_assign (cb_tree vars, const int op, cb_tree val)

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

static cb_tree	build_cond_88 (cb_tree x)

static cb_tree	cb_build_optim_cond (struct cb_binary_op *p)

static int	cb_chk_num_cond (cb_tree x, cb_tree y)

static int	cb_chk_alpha_cond (cb_tree x)

cb_tree	cb_build_cond (cb_tree x)

static cb_tree	cb_build_optim_add (cb_tree v, cb_tree n)

static cb_tree	cb_build_optim_sub (cb_tree v, cb_tree n)

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

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

static unsigned int	emit_corresponding (cb_tree(*func)(cb_tree f1, cb_tree f2, cb_tree f3), cb_tree x1, cb_tree x2, cb_tree opt)

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

static unsigned int	emit_move_corresponding (cb_tree x1, cb_tree x2)

void	cb_emit_move_corresponding (cb_tree x1, cb_tree x2)

static void	output_screen_from (struct cb_field *p, const unsigned int sisters)

static void	output_screen_to (struct cb_field *p, const unsigned int sisters)

static COB_INLINE COB_A_INLINE int	is_less_than_four_or_is_six (int x)

static COB_INLINE COB_A_INLINE int	is_reference_with_value (cb_tree pos)

static COB_INLINE COB_A_INLINE int	value_is_numeric_field (cb_tree pos)

static COB_INLINE COB_A_INLINE int	value_has_picture_clause (cb_tree pos)

static COB_INLINE COB_A_INLINE int	value_pic_has_no_scale (cb_tree pos)

static int	valid_screen_pos_type (cb_tree pos)

static int	valid_screen_pos (cb_tree pos)

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)

void	cb_emit_accept (cb_tree var, cb_tree pos, struct cb_attr_struct *attr_ptr)

void	cb_emit_accept_line_or_col (cb_tree var, const int l_or_c)

void	cb_emit_accept_escape_key (cb_tree var)

void	cb_emit_accept_exception_status (cb_tree var)

void	cb_emit_accept_user_name (cb_tree var)

void	cb_emit_accept_date (cb_tree var)

void	cb_emit_accept_date_yyyymmdd (cb_tree var)

void	cb_emit_accept_day (cb_tree var)

void	cb_emit_accept_day_yyyyddd (cb_tree var)

void	cb_emit_accept_day_of_week (cb_tree var)

void	cb_emit_accept_time (cb_tree var)

void	cb_emit_accept_command_line (cb_tree var)

void	cb_emit_get_environment (cb_tree envvar, cb_tree envval)

void	cb_emit_accept_environment (cb_tree var)

void	cb_emit_accept_arg_number (cb_tree var)

void	cb_emit_accept_arg_value (cb_tree var)

void	cb_emit_accept_mnemonic (cb_tree var, cb_tree mnemonic)

void	cb_emit_accept_name (cb_tree var, cb_tree name)

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

void	cb_emit_alter (cb_tree source, cb_tree target)

void	cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, cb_tree on_exception, cb_tree not_on_exception, cb_tree convention)

void	cb_emit_cancel (cb_tree prog)

void	cb_emit_close (cb_tree file, cb_tree opt)

void	cb_emit_commit (void)

void	cb_emit_continue (void)

void	cb_emit_delete (cb_tree file)

void	cb_emit_delete_file (cb_tree file)

void	cb_emit_env_name (cb_tree value)

void	cb_emit_env_value (cb_tree value)

void	cb_emit_arg_number (cb_tree value)

void	cb_emit_command_line (cb_tree value)

static int	validate_attrs (cb_tree pos, cb_tree fgc, cb_tree bgc, cb_tree scroll, cb_tree size_is)

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)

static void	get_line_and_column_from_pos (const cb_tree pos, cb_tree const line, cb_tree const column)

static void	emit_screen_display (const cb_tree x, const cb_tree pos)

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)

void	cb_emit_display_omitted (cb_tree pos, struct cb_attr_struct *attr_ptr)

void	cb_emit_display (cb_tree values, cb_tree upon, cb_tree no_adv, cb_tree pos, struct cb_attr_struct *attr_ptr)

cb_tree	cb_build_display_mnemonic (cb_tree x)

cb_tree	cb_build_display_name (cb_tree x)

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

static cb_tree	evaluate_test (cb_tree s, cb_tree o)

static void	build_evaluate (cb_tree subject_list, cb_tree case_list, cb_tree labid)

void	cb_emit_evaluate (cb_tree subject_list, cb_tree case_list)

void	cb_emit_free (cb_tree vars)

void	cb_emit_goto (cb_tree target, cb_tree depending)

void	cb_emit_exit (const unsigned int goback)

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

cb_tree	cb_build_if_check_break (cb_tree cond, cb_tree stmts)

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

static void	validate_inspect (cb_tree x, cb_tree y, const unsigned int replconv)

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

void	cb_init_tallying (void)

cb_tree	cb_build_tallying_data (cb_tree x)

cb_tree	cb_build_tallying_characters (cb_tree l)

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 x, cb_tree l)

cb_tree	cb_build_replacing_characters (cb_tree x, cb_tree l)

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

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

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

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

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

cb_tree	cb_build_inspect_region_start (void)

static void	warning_destination (cb_tree x)

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)

static int	count_pic_alphanumeric_edited (struct cb_field *field)

static size_t	cb_check_overlapping (cb_tree src, cb_tree dst, struct cb_field src_f, struct cb_field dst_f)

int	validate_move (cb_tree src, cb_tree dst, const unsigned int is_value)

static cb_tree	cb_build_memset (cb_tree x, const int c)

static cb_tree	cb_build_move_copy (cb_tree src, cb_tree dst)

static cb_tree	cb_build_move_num_zero (cb_tree x)

static cb_tree	cb_build_move_space (cb_tree x)

static cb_tree	cb_build_move_zero (cb_tree x)

static cb_tree	cb_build_move_high (cb_tree x)

static cb_tree	cb_build_move_low (cb_tree x)

static cb_tree	cb_build_move_quote (cb_tree x)

static void	cob_put_sign_ebcdic (unsigned char *p, const int sign)

static cb_tree	cb_build_move_literal (cb_tree src, cb_tree dst)

static cb_tree	cb_build_move_field (cb_tree src, cb_tree dst)

cb_tree	cb_build_move (cb_tree src, cb_tree dst)

void	cb_emit_move (cb_tree src, cb_tree dsts)

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

void	cb_emit_perform (cb_tree perform, cb_tree body)

cb_tree	cb_build_perform_once (cb_tree body)

cb_tree	cb_build_perform_times (cb_tree times)

cb_tree	cb_build_perform_until (cb_tree condition, cb_tree varying)

cb_tree	cb_build_perform_forever (cb_tree body)

cb_tree	cb_build_perform_exit (struct cb_label *label)

void	cb_emit_read (cb_tree ref, cb_tree next, cb_tree into, cb_tree key, cb_tree lock_opts)

void	cb_emit_ready_trace (void)

void	cb_emit_reset_trace (void)

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

void	cb_emit_release (cb_tree record, cb_tree from)

void	cb_emit_return (cb_tree ref, cb_tree into)

void	cb_emit_rollback (void)

static unsigned int	search_set_keys (struct cb_field *f, cb_tree x)

static cb_tree	cb_build_search_all (cb_tree table, cb_tree cond)

void	cb_emit_search (cb_tree table, cb_tree varying, cb_tree at_end, cb_tree whens)

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

void	cb_emit_setenv (cb_tree x, cb_tree y)

void	cb_emit_set_to (cb_tree vars, cb_tree x)

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

void	cb_emit_set_on_off (cb_tree l, cb_tree flag)

void	cb_emit_set_true (cb_tree l)

void	cb_emit_set_false (cb_tree l)

void	cb_emit_set_attribute (cb_tree x, const int val_on, const int val_off)

void	cb_emit_set_last_exception_to_off (void)

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

void	cb_emit_sort_using (cb_tree file, cb_tree l)

void	cb_emit_sort_input (cb_tree proc)

void	cb_emit_sort_giving (cb_tree file, cb_tree l)

void	cb_emit_sort_output (cb_tree proc)

void	cb_emit_sort_finish (cb_tree file)

static unsigned int	check_valid_key (const struct cb_file cbf, const struct cb_field f)

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

void	cb_emit_stop_run (cb_tree x)

void	cb_emit_string (cb_tree items, cb_tree into, cb_tree pointer)

void	cb_emit_unlock (cb_tree ref)

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

cb_tree	cb_build_unstring_delimited (cb_tree all, cb_tree value)

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

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

cb_tree	cb_build_write_advancing_lines (cb_tree pos, cb_tree lines)

cb_tree	cb_build_write_advancing_mnemonic (cb_tree pos, cb_tree mnemonic)

cb_tree	cb_build_write_advancing_page (cb_tree pos)

void	cobc_init_typeck (void)

Variables
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

size_t	suppress_warn = 0

static cb_tree	decimal_stack = ((void*)0)

static const char *	inspect_func

static cb_tree	inspect_data

static int	expr_op

static cb_tree	expr_lh

static size_t	initialized = 0

static size_t	overlapping = 0

static int	expr_index

static int	expr_stack_size

static struct expr_node *	expr_stack

static const unsigned char	hexval [] = "0123456789ABCDEF"

static unsigned char	expr_prio [256]

static unsigned char	valid_char [256]

static const unsigned char	pvalid_char []

static const unsigned char	cob_refer_ascii [256]

static const unsigned char	cob_refer_ebcdic [256]

static const struct system_table	system_tab []

static const struct optim_table	bin_set_funcs []

static const struct optim_table	bin_compare_funcs []

static const struct optim_table	bin_add_funcs []

static const struct optim_table	bin_sub_funcs []

Macro Definition Documentation

#define cb_emit ( x ) current_statement->body = cb_list_add (current_statement->body, x)

Definition at line 75 of file typeck.c.

Referenced by build_evaluate(), cb_build_length(), cb_check_data_incompat(), cb_emit_accept(), cb_emit_accept_arg_number(), cb_emit_accept_arg_value(), cb_emit_accept_command_line(), cb_emit_accept_date(), cb_emit_accept_date_yyyymmdd(), cb_emit_accept_day(), cb_emit_accept_day_of_week(), cb_emit_accept_day_yyyyddd(), cb_emit_accept_environment(), cb_emit_accept_escape_key(), cb_emit_accept_exception_status(), cb_emit_accept_line_or_col(), cb_emit_accept_mnemonic(), cb_emit_accept_name(), cb_emit_accept_time(), cb_emit_accept_user_name(), cb_emit_allocate(), cb_emit_alter(), cb_emit_arg_number(), cb_emit_call(), cb_emit_cancel(), cb_emit_close(), cb_emit_command_line(), cb_emit_commit(), cb_emit_continue(), cb_emit_delete(), cb_emit_delete_file(), cb_emit_display(), cb_emit_divide(), cb_emit_env_name(), cb_emit_env_value(), cb_emit_evaluate(), cb_emit_exit(), cb_emit_free(), cb_emit_get_environment(), cb_emit_goto(), cb_emit_if(), cb_emit_initialize(), cb_emit_inspect(), cb_emit_move(), cb_emit_open(), cb_emit_perform(), cb_emit_read(), cb_emit_ready_trace(), cb_emit_release(), cb_emit_reset_trace(), cb_emit_return(), cb_emit_rewrite(), cb_emit_rollback(), cb_emit_search(), cb_emit_search_all(), cb_emit_set_attribute(), cb_emit_set_false(), cb_emit_set_last_exception_to_off(), cb_emit_set_on_off(), cb_emit_set_to(), cb_emit_set_true(), cb_emit_set_up_down(), cb_emit_setenv(), cb_emit_sort_finish(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_input(), cb_emit_sort_output(), cb_emit_sort_using(), cb_emit_start(), cb_emit_stop_run(), cb_emit_string(), cb_emit_unlock(), cb_emit_unstring(), cb_emit_write(), cb_gen_field_accept(), decimal_expand(), emit_corresponding(), emit_field_display(), emit_move_corresponding(), emit_screen_display(), output_screen_from(), and output_screen_to().

#define cb_emit_list ( l ) current_statement->body = cb_list_append (current_statement->body, l)

Definition at line 77 of file typeck.c.

Referenced by cb_emit_arithmetic(), cb_emit_inspect(), and cb_emit_unstring().

#define COB_SYSTEM_GEN	(	x,
		y,
		z
	)	{ x, y },

Definition at line 280 of file typeck.c.

#define dpush ( x ) CB_ADD_TO_CHAIN (x, decimal_stack)

Definition at line 73 of file typeck.c.

Referenced by cb_build_cond(), decimal_assign(), decimal_compute(), and decimal_expand().

#define START_STACK_SIZE 32

Definition at line 69 of file typeck.c.

Referenced by cb_expr_init().

#define TOKEN ( offset ) (expr_stack[expr_index + offset].token)

Definition at line 70 of file typeck.c.

Referenced by cb_expr_shift(), cb_expr_shift_class(), cb_expr_shift_sign(), expr_reduce(), and pplex().

#define VALUE ( offset ) (expr_stack[expr_index + offset].value)

Definition at line 71 of file typeck.c.

Referenced by cb_expr_shift(), cb_expr_shift_class(), cb_expr_shift_sign(), and expr_reduce().

Function Documentation

static cb_tree build_cond_88 ( cb_tree x )

static

Definition at line 3519 of file typeck.c.

References cb_build_binary_op(), cb_build_field_reference(), CB_CHAIN, cb_error_node, CB_FIELD_PTR, CB_PAIR_P, CB_PAIR_X, CB_PAIR_Y, CB_VALUE, cb_field::count, NULL, cb_field::parent, and cb_field::values.

Referenced by cb_build_cond(), and search_set_keys().

 {
     struct cb_field *f;
     cb_tree     l;
     cb_tree     t;
     cb_tree     c1;
     cb_tree     c2;
 
     f = CB_FIELD_PTR (x);
     /* Refer to parents data storage */
     if (!f->parent) {
         /* Field is invalid */
         return cb_error_node;
     }
     x = cb_build_field_reference (f->parent, x);
     f->parent->count++;
     c1 = NULL;
 
     /* Build condition */
     for (l = f->values; l; l = CB_CHAIN (l)) {
         t = CB_VALUE (l);
         if (CB_PAIR_P (t)) {
             /* VALUE THRU VALUE */
             c2 = cb_build_binary_op (cb_build_binary_op (CB_PAIR_X (t), '[', x),
                          '&', cb_build_binary_op (x, '[', CB_PAIR_Y (t)));
         } else {
             /* VALUE */
             c2 = cb_build_binary_op (x, '=', t);
         }
         if (c1 == NULL) {
             c1 = c2;
         } else {
             c1 = cb_build_binary_op (c1, '|', c2);
         }
     }
     return c1;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree build_decimal_assign	(	cb_tree	vars,
		const int	op,
		cb_tree	val
	)

static

Definition at line 3412 of file typeck.c.

References CB_CHAIN, cb_list_append(), cb_list_reverse(), CB_PURPOSE, CB_VALUE, decimal_alloc(), decimal_assign(), decimal_compute(), decimal_expand(), decimal_free(), and NULL.

Referenced by cb_emit_arithmetic().

 {
     cb_tree l;
     cb_tree t;
     cb_tree s1;
     cb_tree s2;
     cb_tree d;
 
     d = decimal_alloc ();
 
     /* Set d, VAL */
     decimal_expand (d, val);
 
     s1 = NULL;
     if (op == 0) {
         for (l = vars; l; l = CB_CHAIN (l)) {
             /* Set VAR, d */
             decimal_assign (CB_VALUE (l), d, CB_PURPOSE (l));
             s2 = cb_list_reverse (decimal_stack);
             if (!s1) {
                 s1 = s2;
             } else {
                 s1 = cb_list_append (s1, s2);
             }
             decimal_stack = NULL;
         }
     } else {
         t = decimal_alloc ();
         for (l = vars; l; l = CB_CHAIN (l)) {
             /* Set t, VAR
              * OP t, d
              * set VAR, t
              */
             decimal_expand (t, CB_VALUE (l));
             decimal_compute (op, t, d);
             decimal_assign (CB_VALUE (l), t, CB_PURPOSE (l));
             s2 = cb_list_reverse (decimal_stack);
             if (!s1) {
                 s1 = s2;
             } else {
                 s1 = cb_list_append (s1, s2);
             }
             decimal_stack = NULL;
         }
         decimal_free ();
     }
 
     decimal_free ();
 
     return s1;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void build_evaluate	(	cb_tree	subject_list,
		cb_tree	case_list,
		cb_tree	labid
	)

static

Definition at line 5493 of file typeck.c.

References _, cb_build_binary_op(), cb_build_comment(), cb_build_cond(), cb_build_if(), CB_CHAIN, cb_emit, cb_error(), cb_error_node, CB_GOTO_P, cb_list_add(), CB_STATEMENT, CB_STATEMENT_P, CB_VALUE, evaluate_test(), and NULL.

Referenced by cb_emit_evaluate().

 {
     cb_tree     c1;
     cb_tree     c2;
     cb_tree     c3;
     cb_tree     subjs;
     cb_tree     whens;
     cb_tree     objs;
     cb_tree     stmt;
 
     if (case_list == NULL) {
         return;
     }
 
     whens = CB_VALUE (case_list);
     stmt = CB_VALUE (whens);
     whens = CB_CHAIN (whens);
     c1 = NULL;
 
     /* For each WHEN sequence */
     for (; whens; whens = CB_CHAIN (whens)) {
         c2 = NULL;
         /* Single WHEN test */
         for (subjs = subject_list, objs = CB_VALUE (whens);
              subjs && objs;
              subjs = CB_CHAIN (subjs), objs = CB_CHAIN (objs)) {
             c3 = evaluate_test (CB_VALUE (subjs), CB_VALUE (objs));
             if (c3 == NULL || c3 == cb_error_node) {
                 return;
             }
 
             if (c2 == NULL) {
                 c2 = c3;
             } else {
                 c2 = cb_build_binary_op (c2, '&', c3);
                 if (c2 == cb_error_node) {
                     return;
                 }
             }
         }
         if (subjs || objs) {
             cb_error (_("Wrong number of WHEN parameters"));
         }
         /* Connect multiple WHEN's */
         if (c1 == NULL) {
             c1 = c2;
         } else {
             c1 = cb_build_binary_op (c1, '|', c2);
             if (c1 == cb_error_node) {
                 return;
             }
         }
     }
 
     if (c1 == NULL) {
         cb_emit (cb_build_comment ("WHEN OTHER"));
         cb_emit (stmt);
     } else {
         c2 = stmt;
         /* Check if last statement is GO TO */
         for (c3 = stmt; c3; c3 = CB_CHAIN (c3)) {
             if (!CB_CHAIN(c3)) {
                 break;
             }
         }
         if (c3 && CB_VALUE (c3) && CB_STATEMENT_P (CB_VALUE (c3))) {
             c3 = CB_STATEMENT(CB_VALUE(c3))->body;
             if (c3 && CB_VALUE (c3) && !CB_GOTO_P (CB_VALUE(c3))) {
                 /* Append the jump */
                 c2 = cb_list_add (stmt, labid);
             }
         }
         cb_emit (cb_build_if (cb_build_cond (c1), c2, NULL, 0));
         build_evaluate (subject_list, CB_CHAIN (case_list), labid);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree build_store_option	(	cb_tree	x,
		cb_tree	round_opt
	)

static

Definition at line 3193 of file typeck.c.

References CB_FIELD_PTR, cb_int(), CB_INTEGER, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_X, CB_USAGE_DOUBLE, CB_USAGE_FLOAT, COB_STORE_KEEP_ON_OVERFLOW, COB_STORE_TRUNC_ON_OVERFLOW, current_statement, cb_statement::handler1, cb_statement::handler_id, and cb_field::usage.

Referenced by cb_build_add(), cb_build_div(), cb_build_mul(), cb_build_sub(), cb_emit_divide(), and decimal_assign().

 {
     struct cb_field *f;
     int     opt;
     enum cb_usage   usage;
 
     f = CB_FIELD_PTR (x);
     usage = f->usage;
 #if 0   /* RXWRXW - FP */
     if (usage == CB_USAGE_DOUBLE || usage == CB_USAGE_FLOAT) {
         /* Rounding on FP is useless */
         opt = 0;
     } else {
 #endif
         opt = CB_INTEGER (round_opt)->val;
 #if 0   /* RXWRXW - FP */
     }
 #endif
 
     if (usage == CB_USAGE_COMP_5 || usage == CB_USAGE_COMP_X) {
         /* Do not check NOT ERROR case, so that we optimize */
         if (current_statement->handler1) {
             opt |= COB_STORE_KEEP_ON_OVERFLOW;
         }
     } else if (current_statement->handler_id) {
         /* There is a [NOT] ERROR/OVERFLOW/EXCEPTION - Set in parser */
         opt |= COB_STORE_KEEP_ON_OVERFLOW;
     } else if (usage == CB_USAGE_BINARY && cb_binary_truncate) {
         /* Truncate binary field to digits in picture */
         opt |= COB_STORE_TRUNC_ON_OVERFLOW;
     }
 
     return cb_int (opt);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 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().

 {
     cb_tree     opt;
     struct cb_field *f;
 
 #ifdef  COB_NON_ALIGNED
     if (CB_INDEX_P (v)) {
         return cb_build_move (cb_build_binary_op (v, '+', n), v);
     }
     if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
         optimize_defs[COB_POINTER_MANIP] = 1;
         return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", v, n, cb_int0);
     }
 #else
     if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
         return cb_build_move (cb_build_binary_op (v, '+', n), v);
     }
 #endif
 
     if (CB_REF_OR_FIELD_P (v)) {
         f = CB_FIELD_PTR (v);
         f->count++;
     }
     if (CB_REF_OR_FIELD_P (n)) {
         f = CB_FIELD_PTR (n);
         f->count++;
     }
     if (round_opt == cb_high) {
         /* Short circuit from tree.c for perform */
         if (cb_fits_int (n)) {
             return cb_build_optim_add (v, n);
         } else {
             return CB_BUILD_FUNCALL_3 ("cob_add", v, n, cb_int0);
         }
     }
     opt = build_store_option (v, round_opt);
     if (opt == cb_int0 && cb_fits_int (n)) {
         return cb_build_optim_add (v, n);
     }
     return CB_BUILD_FUNCALL_3 ("cob_add", v, n, opt);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_address ( cb_tree x )

Definition at line 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().

 {
     cb_tree         v;
     struct cb_reference *r;
     const char      *name;
     int         numsubs;
     int         refsubs;
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
     if (!CB_REFERENCE_P (x)) {
         return CB_BUILD_CAST_ADDRESS (x);
     }
 
     r = CB_REFERENCE (x);
     name = r->word->name;
     v = cb_ref (x);
     if (v == cb_error_node) {
         return cb_error_node;
     }
 
     refsubs = cb_list_length (r->subs);
     if (CB_FIELD_P (v)) {
         numsubs = CB_FIELD (v)->indexes;
         if (refsubs > numsubs) {
             goto subserror;
         } else if (refsubs < numsubs) {
             if (!cb_relaxed_syntax_check) {
                 goto subserror;
             } else {
                 cb_warning_x (x,
                         _("Subscripts missing for '%s' - Defaulting to 1"),
                         name);
                 for (; refsubs < numsubs; ++refsubs) {
                     CB_ADD_TO_CHAIN (cb_one, r->subs);
                 }
             }
         }
     } else {
         numsubs = 0;
         if (r->subs) {
             goto subserror;
         }
         if (r->offset) {
             cb_error_x (x, _("'%s' cannot be reference modified"), name);
             return cb_error_node;
         }
     }
 
     return CB_BUILD_CAST_ADDRESS (x);
 
 subserror:
     switch (numsubs) {
     case 0:
         cb_error_x (x, _("'%s' cannot be subscripted"), name);
         break;
     case 1:
         cb_error_x (x, _("'%s' requires 1 subscript"), name);
         break;
     default:
         cb_error_x (x, _("'%s' requires %d subscripts"),
                 name, numsubs);
         break;
     }
     return cb_error_node;
 }

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 *	cfile,
		cb_tree	name
	)

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

 {
     const char  *s;
     const char  *p;
 
     if (name == cb_error_node) {
         return cb_error_node;
     }
     /* For special assignment */
     if (name == NULL) {
         return NULL;
     }
 
     switch (CB_TREE_TAG (name)) {
     case CB_TAG_LITERAL:
         return name;
 
     case CB_TAG_REFERENCE:
         s = CB_NAME (name);
         if (cb_assign_clause == CB_ASSIGN_MF) {
             if (cfile->flag_ext_assign) {
                 p = strrchr (s, '-');
                 if (p) {
                     s = p + 1;
                 }
                 return cb_build_alphanumeric_literal (s, strlen (s));
             }
             current_program->reference_list =
                 cb_list_add (current_program->reference_list, name);
             return name;
         } else if (cb_assign_clause == CB_ASSIGN_IBM) {
             /* Check organization */
             if (strncmp (s, "S-", (size_t)2) == 0 ||
                 strncmp (s, "AS-", (size_t)3) == 0) {
                 goto org;
             }
             /* Skip the device label if exists */
             if ((p = strchr (s, '-')) != NULL) {
                 s = p + 1;
             }
             /* Check organization again */
             if (strncmp (s, "S-", (size_t)2) == 0 ||
                 strncmp (s, "AS-", (size_t)3) == 0) {
 org:
                 /* Skip it for now */
                 s = strchr (s, '-') + 1;
             }
             /* Convert the name into literal */
             if (warningopt) {
                 cb_warning (_("ASSIGN interpreted as %s"), s);
             }
             return cb_build_alphanumeric_literal (s, strlen (s));
         }
         /* Fall through for CB_ASSIGN_COBOL2002 */
         /* To be looked at */
     default:
         return cb_error_node;
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_cond ( cb_tree x )

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

 {
     struct cb_field     *f;
     struct cb_binary_op *p;
     cb_tree         d1;
     cb_tree         d2;
     int         size1;
     int         size2;
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
     switch (CB_TREE_TAG (x)) {
     case CB_TAG_CONST:
         if (x != cb_any && x != cb_true && x != cb_false) {
             cb_error_x (CB_TREE(current_statement),
                     _("Invalid expression"));
             return cb_error_node;
         }
         return x;
     case CB_TAG_FUNCALL:
         return x;
     case CB_TAG_REFERENCE:
         if (!CB_FIELD_P (cb_ref (x))) {
             return cb_build_cond (cb_ref (x));
         }
 
         f = CB_FIELD_PTR (x);
 
         /* Level 88 condition */
         if (f->level == 88) {
             /* Build an 88 condition at every occurrence */
             /* as it may be subscripted */
             return cb_build_cond (build_cond_88 (x));
         }
 
         break;
     case CB_TAG_BINARY_OP:
         p = CB_BINARY_OP (x);
         if (!p->x || p->x == cb_error_node) {
             return cb_error_node;
         }
         switch (p->op) {
         case '!':
             return CB_BUILD_NEGATION (cb_build_cond (p->x));
         case '&':
         case '|':
             if (!p->y || p->y == cb_error_node) {
                 return cb_error_node;
             }
             return cb_build_binary_op (cb_build_cond (p->x), p->op, cb_build_cond (p->y));
         default:
             if (!p->y || p->y == cb_error_node) {
                 return cb_error_node;
             }
             if (CB_INDEX_P (p->x) || CB_INDEX_P (p->y) ||
                 CB_TREE_CLASS (p->x) == CB_CLASS_POINTER ||
                 CB_TREE_CLASS (p->y) == CB_CLASS_POINTER) {
                 x = cb_build_binary_op (p->x, '-', p->y);
             } else if (CB_BINARY_OP_P (p->x) ||
                    CB_BINARY_OP_P (p->y)) {
                 /* Decimal comparison */
                 d1 = decimal_alloc ();
                 d2 = decimal_alloc ();
 
                 decimal_expand (d1, p->x);
                 decimal_expand (d2, p->y);
                 dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_cmp", d1, d2));
                 decimal_free ();
                 decimal_free ();
                 x = cb_list_reverse (decimal_stack);
                 decimal_stack = NULL;
             } else {
                 /* DEBUG Bypass optimization for PERFORM */
                 if (current_program->flag_debugging) {
                     x = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y);
                     break;
                 }
                 if (cb_chk_num_cond (p->x, p->y)) {
                     size1 = cb_field_size (p->x);
                     x = CB_BUILD_FUNCALL_3 ("memcmp",
                         CB_BUILD_CAST_ADDRESS (p->x),
                         CB_BUILD_CAST_ADDRESS (p->y),
                         cb_int (size1));
                     break;
                 }
                 if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC &&
                     CB_TREE_CLASS (p->y) == CB_CLASS_NUMERIC &&
                     cb_fits_long_long (p->y)) {
                     x = cb_build_optim_cond (p);
                     break;
                 }
 
                 /* Field comparison */
                 if ((CB_REF_OR_FIELD_P (p->x)) &&
                     (CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHANUMERIC ||
                      CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHABETIC) &&
                     cb_field_size (p->x) == 1 &&
                     !current_program->alphabet_name_list &&
                     (p->y == cb_space || p->y == cb_low ||
                      p->y == cb_high || p->y == cb_zero)) {
                     x = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y);
                     break;
                 }
                 if (cb_chk_alpha_cond (p->x) &&
                     cb_chk_alpha_cond (p->y)) {
                     size1 = cb_field_size (p->x);
                     size2 = cb_field_size (p->y);
                 } else {
                     size1 = 0;
                     size2 = 0;
                 }
                 if (size1 == 1 && size2 == 1) {
                     x = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y);
                 } else if (size1 != 0 && size1 == size2) {
                     x = CB_BUILD_FUNCALL_3 ("memcmp",
                         CB_BUILD_CAST_ADDRESS (p->x),
                         CB_BUILD_CAST_ADDRESS (p->y),
                         cb_int (size1));
                 } else {
                     if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC && p->y == cb_zero) {
                         x = cb_build_optim_cond (p);
                     } else {
                         x = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y);
                     }
                 }
             }
         }
         return cb_build_binary_op (x, p->op, p->y);
     default:
         break;
     }
     cb_error_x (x, _("Invalid expression"));
     return cb_error_node;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_const_length ( cb_tree x )

Definition at line 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().

 {
     struct cb_field     *f;
     char            buff[32];
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
     if (CB_INTEGER_P (x)) {
         sprintf (buff, "%d", CB_INTEGER(x)->val);
         return cb_build_numeric_literal (0, buff, 0);
     }
     if (CB_REFERENCE_P (x)) {
         if (cb_ref (x) == cb_error_node) {
             return cb_error_node;
         }
         if (CB_REFERENCE (x)->offset) {
             cb_error (_("Reference modification not allowed here"));
             return cb_error_node;
         }
     }
 
     memset (buff, 0, sizeof (buff));
     f = CB_FIELD (cb_ref (x));
     if (f->flag_any_length) {
         cb_error (_("ANY LENGTH item not allowed here"));
         return cb_error_node;
     }
     if (f->level == 88) {
         cb_error (_("88 level item not allowed here"));
         return cb_error_node;
     }
     if (cb_field_variable_size (f)) {
         cb_error (_("Variable length item not allowed here"));
         return cb_error_node;
     }
     if (f->redefines) {
         cb_validate_field (f->redefines);
         if (f->rename_thru) {
             cb_validate_field (f->rename_thru);
         }
         cb_validate_field (f);
         sprintf (buff, "%d", f->size);
     } else {
         cb_validate_field (f);
         sprintf (buff, "%d", f->memory_size);
     }
     return cb_build_numeric_literal (0, buff, 0);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 5954 of file typeck.c.

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

Referenced by yyparse().

 {
     validate_inspect (x, y, 2);
     return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_converting", x, y));
 }

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

 {
     cb_tree         l;
     cb_tree         x;
     cb_tree         assign;
 
     /* Set up DEBUG-ITEM */
     l = cb_build_reference ("DEBUG-ITEM");
     assign = cb_build_field_tree (NULL, l, NULL, CB_STORAGE_WORKING,
                  NULL, 1);
     CB_FIELD (assign)->values = CB_LIST_INIT (cb_space);
     cb_debug_item = l;
 
     l = cb_build_reference ("DEBUG-LINE");
     x = cb_build_field_tree (NULL, l, CB_FIELD(assign),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("9(6)"));
     cb_validate_field (CB_FIELD (x));
     cb_debug_line = l;
 
     l = cb_build_filler ();
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
     CB_FIELD (x)->flag_filler = 1;
     cb_validate_field (CB_FIELD (x));
 
     l = cb_build_reference ("DEBUG-NAME");
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(31)"));
     cb_validate_field (CB_FIELD (x));
     cb_debug_name = l;
 
     l = cb_build_filler ();
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
     CB_FIELD (x)->flag_filler = 1;
     cb_validate_field (CB_FIELD (x));
 
     l = cb_build_reference ("DEBUG-SUB-1");
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
     CB_FIELD (x)->flag_sign_leading = 1;
     CB_FIELD (x)->flag_sign_separate = 1;
     cb_validate_field (CB_FIELD (x));
     cb_debug_sub_1 = l;
 
     l = cb_build_filler ();
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
     CB_FIELD (x)->flag_filler = 1;
     cb_validate_field (CB_FIELD (x));
 
     l = cb_build_reference ("DEBUG-SUB-2");
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
     CB_FIELD (x)->flag_sign_leading = 1;
     CB_FIELD (x)->flag_sign_separate = 1;
     cb_validate_field (CB_FIELD (x));
     cb_debug_sub_2 = l;
 
     l = cb_build_filler ();
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
     CB_FIELD (x)->flag_filler = 1;
     cb_validate_field (CB_FIELD (x));
 
     l = cb_build_reference ("DEBUG-SUB-3");
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)"));
     CB_FIELD (x)->flag_sign_leading = 1;
     CB_FIELD (x)->flag_sign_separate = 1;
     cb_validate_field (CB_FIELD (x));
     cb_debug_sub_3 = l;
 
     l = cb_build_filler ();
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X"));
     CB_FIELD (x)->flag_filler = 1;
     cb_validate_field (CB_FIELD (x));
 
     l = cb_build_reference ("DEBUG-CONTENTS");
     x = cb_build_field_tree (NULL, l, CB_FIELD(x),
                  CB_STORAGE_WORKING, NULL, 3);
     CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(31)"));
     cb_validate_field (CB_FIELD (x));
     cb_debug_contents = l;
 
     cb_validate_field (CB_FIELD (assign));
     CB_FIELD_ADD (current_program->working_storage, CB_FIELD (assign));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_display_mnemonic ( cb_tree x )

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_display_name ( cb_tree x )

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

 {
     const char  *name;
     cb_tree     sys;
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
     name = CB_NAME (x);
     /* Allow direct reference to a device name */
     sys = lookup_system_name (name);
     if (sys) {
         switch (CB_SYSTEM_NAME (sys)->token) {
         case CB_DEVICE_CONSOLE:
         case CB_DEVICE_SYSOUT:
             if (!cb_relaxed_syntax_check) {
                 cb_warning_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
             }
             return cb_int0;
         case CB_DEVICE_SYSERR:
             if (!cb_relaxed_syntax_check) {
                 cb_warning_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
             }
             return cb_int1;
         default:
             cb_error_x (x, _("'%s' is not an output device"), name);
             return cb_error_node;
         }
     }
 
     cb_error_x (x, _("'%s' is not defined in SPECIAL-NAMES"), name);
     return cb_error_node;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_div	(	cb_tree	v,
		cb_tree	n,
		cb_tree	round_opt
	)

static

Definition at line 3390 of file typeck.c.

References build_store_option(), cb_build_binary_op(), CB_BUILD_FUNCALL_3, cb_build_move(), CB_FIELD_PTR, CB_INDEX_P, CB_REF_OR_FIELD_P, and cb_field::count.

Referenced by cb_emit_arithmetic().

 {
     cb_tree     opt;
     struct cb_field *f;
 
     if (CB_INDEX_P (v)) {
         return cb_build_move (cb_build_binary_op (v, '/', n), v);
     }
 
     if (CB_REF_OR_FIELD_P (v)) {
         f = CB_FIELD_PTR (v);
         f->count++;
     }
     if (CB_REF_OR_FIELD_P (n)) {
         f = CB_FIELD_PTR (n);
         f->count++;
     }
     opt = build_store_option (v, round_opt);
     return CB_BUILD_FUNCALL_3 ("cob_div", v, n, opt);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_expr ( cb_tree list )

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

 {
     cb_tree l;
     int op;
 
     cb_expr_init ();
 
     for (l = list; l; l = CB_CHAIN (l)) {
         op = CB_PURPOSE_INT (l);
         switch (op) {
         case '9':
             /* NUMERIC */
             cb_expr_shift_class ("cob_is_numeric");
             break;
         case 'A':
             /* ALPHABETIC */
             cb_expr_shift_class ("cob_is_alpha");
             break;
         case 'L':
             /* ALPHABETIC_LOWER */
             cb_expr_shift_class ("cob_is_lower");
             break;
         case 'U':
             /* ALPHABETIC_UPPER */
             cb_expr_shift_class ("cob_is_upper");
             break;
         case 'P':
             /* POSITIVE */
             cb_expr_shift_sign ('>');
             break;
         case 'N':
             /* NEGATIVE */
             cb_expr_shift_sign ('<');
             break;
         case 'O':
             /* OMITTED */
             if (current_statement) {
                 current_statement->null_check = NULL;
             }
             cb_expr_shift_class ("cob_is_omitted");
             break;
         case 'C':
             /* CLASS */
             cb_expr_shift_class (CB_CLASS_NAME (cb_ref (CB_VALUE (l)))->cname);
             break;
         default:
             cb_expr_shift (op, CB_VALUE (l));
             break;
         }
     }
 
     return cb_expr_finish ();
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_identifier	(	cb_tree	x,
		const int	subchk
	)

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

 {
     struct cb_reference *r;
     struct cb_field     *f;
     struct cb_field     *p;
     const char      *name;
     char        full_name[COB_MAX_WORDLEN * 2 + 10];
     cb_tree         xr;
     cb_tree         v;
     cb_tree         e1;
     cb_tree         l;
     cb_tree         sub;
     int         offset;
     int         length;
     int         n;
     int         numsubs;
     int         refsubs;
     int         pseudosize;
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
 
     r = CB_REFERENCE (x);
     name = r->word->name;
 
     /* Resolve reference */
     v = cb_ref (x);
     if (v == cb_error_node) {
         return cb_error_node;
     }
 
     /* Check if it is a data name */
     if (!CB_FIELD_P (v)) {
         if (r->subs) {
             cb_error_x (x, _("'%s' cannot be subscripted"), name);
             return cb_error_node;
         }
         if (r->offset) {
             cb_error_x (x, _("'%s' cannot be reference modified"), name);
             return cb_error_node;
         }
         return x;
     }
     f = CB_FIELD (v);
 
     /* BASED check and check for OPTIONAL LINKAGE items */
     if (current_statement &&
         (CB_EXCEPTION_ENABLE (COB_EC_DATA_PTR_NULL) ||
          CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_ARG_OMITTED))) {
         p = cb_field_founder (f);
         if (p->redefines) {
             p = p->redefines;
         }
         if (p == f) {
             sprintf(full_name, "'%s'", name);
         } else {
             sprintf(full_name, _("'%s' (accessed by '%s')"), p->name, name);
         }
         xr = cb_build_reference(full_name);
 
         if (CB_EXCEPTION_ENABLE (COB_EC_DATA_PTR_NULL) &&
             !current_statement->flag_no_based) {
             if (p->flag_item_based ||
                (p->storage == CB_STORAGE_LINKAGE &&
                   !p->flag_is_pdiv_parm)) {
                 current_statement->null_check = CB_BUILD_FUNCALL_2 (
                     "cob_check_based",
                     cb_build_address (cb_build_field_reference (p, NULL)),
                     CB_BUILD_STRING0 (CB_REFERENCE(xr)->word->name));
             }
         }
         if (CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_ARG_OMITTED) &&
             p->flag_is_pdiv_opt) {
             current_statement->null_check = CB_BUILD_FUNCALL_3 (
                 "cob_check_linkage",
                 cb_build_address (cb_build_field_reference (p, NULL)),
                 CB_BUILD_STRING0 (CB_REFERENCE(xr)->word->name), cb_int1);
         }
     }
 
     for (l = r->subs; l; l = CB_CHAIN (l)) {
         if (CB_BINARY_OP_P (CB_VALUE (l))) {
             /* Set special flag for codegen */
             CB_BINARY_OP(CB_VALUE(l))->flag = 1;
         }
     }
 
     /* Check the number of subscripts */
     numsubs = refsubs = cb_list_length (r->subs);
     cb_check_lit_subs (r, numsubs, f->indexes);
     if (subchk) {
         if (!f->indexes) {
             cb_error_x (x, _("'%s' has no OCCURS clause"), name);
             return cb_error_node;
         }
         numsubs = f->indexes - 1;
     } else {
         numsubs = f->indexes;
     }
     if (unlikely(!r->flag_all)) {
         if (refsubs != numsubs) {
             if (refsubs > numsubs) {
                 goto refsubserr;
             } else if (refsubs < numsubs) {
                 if (!cb_relaxed_syntax_check) {
                     goto refsubserr;
                 } else {
                     cb_warning_x (x,
                             _("Subscripts missing for '%s' - Defaulting to 1"),
                             name);
                     for (; refsubs < numsubs; ++refsubs) {
                         CB_ADD_TO_CHAIN (cb_one, r->subs);
                     }
                 }
             }
         }
 
         /* Run-time check for ODO (including all the fields subordinate items) */
         if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT) && f->odo_level != 0) {
             for (p = f; p; p = p->children) {
                 if (p->depending) {
                     e1 = CB_BUILD_FUNCALL_4 ("cob_check_odo",
                          cb_build_cast_int (p->depending),
                          cb_int (p->occurs_min),
                          cb_int (p->occurs_max),
                          CB_BUILD_STRING0
                          ((CB_FIELD_PTR (p->depending)->name)));
                     r->check = cb_list_add (r->check, e1);
                 }
             }
         }
 
         /* Subscript check along with setting of table offset */
         if (r->subs) {
             l = r->subs;
             for (p = f; p; p = p->parent) {
                 if (!p->flag_occurs) {
                     continue;
                 }
 
 #if 1   /* RXWRXW - Sub check */
                 if (!l) {
                     break;
                 }
 #endif
                 sub = cb_check_integer_value (CB_VALUE (l));
                 l = CB_CHAIN (l);
                 if (sub == cb_error_node) {
                     continue;
                 }
 
                 /* Compile-time check for all literals */
                 if (CB_LITERAL_P (sub)) {
                     n = cb_get_int (sub);
                     if (n < 1 || n > p->occurs_max) {
                         cb_error_x (x, _("Subscript of '%s' out of bounds: %d"),
                                 name, n);
                     }
                     if (p==f) {
                         /* Only valid for single subscript (!) */
                         f->mem_offset = f->size * (n - 1);
                     }
                 }
 
                 /* Run-time check for all non-literals */
                 if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) {
                     if (p->depending) {
                         e1 = CB_BUILD_FUNCALL_4 ("cob_check_subscript",
                              cb_build_cast_int (sub),
                              cb_int1,
                              cb_build_cast_int (p->depending),
                              CB_BUILD_STRING0 (name));
                         r->check = cb_list_add (r->check, e1);
                     } else {
                         if (!CB_LITERAL_P (sub)) {
                             e1 = CB_BUILD_FUNCALL_4 ("cob_check_subscript",
                                  cb_build_cast_int (sub),
                                  cb_int1,
                                  cb_int (p->occurs_max),
                                  CB_BUILD_STRING0 (name));
                             r->check = cb_list_add (r->check, e1);
                         }
                     }
                 }
             }
         }
 
     }
 
     if (subchk) {
         r->subs = cb_list_reverse (r->subs);
         r->subs = cb_list_add (r->subs, cb_int1);
         r->subs = cb_list_reverse (r->subs);
     }
 
     /* Reference modification check */
     if ( f->usage == CB_USAGE_NATIONAL ) {
         pseudosize = f->size / 2;
     } else {
         pseudosize = f->size;
     }
     if (r->offset) {
         /* Compile-time check */
         if (CB_LITERAL_P (r->offset)) {
             offset = cb_get_int (r->offset);
             if (f->flag_any_length) {
                 if (offset < 1) {
                     cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset);
                 } else if (r->length && CB_LITERAL_P (r->length)) {
                     length = cb_get_int (r->length);
                     if (length < 1) {
                         cb_error_x (x, _("Length of '%s' out of bounds: %d"),
                                 name, length);
                     }
                 }
             } else {
                 if (offset < 1 || offset > pseudosize) {
                     cb_error_x (x, _("Offset of '%s' out of bounds: %d"), name, offset);
                 } else if (r->length && CB_LITERAL_P (r->length)) {
                     length = cb_get_int (r->length);
                     if (length < 1 || length > pseudosize - offset + 1) {
                         cb_error_x (x, _("Length of '%s' out of bounds: %d"),
                                 name, length);
                     }
                 }
             }
         }
 
         /* Run-time check */
         if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_REF_MOD)) {
             if (f->flag_any_length || !CB_LITERAL_P (r->offset) ||
                 (r->length && !CB_LITERAL_P (r->length))) {
                 e1 = CB_BUILD_FUNCALL_4 ("cob_check_ref_mod",
                              cb_build_cast_int (r->offset),
                              r->length ?
                               cb_build_cast_int (r->length) :
                               cb_int1,
                              f->flag_any_length ?
                               CB_BUILD_CAST_LENGTH (v) :
                               cb_int (pseudosize),
                              CB_BUILD_STRING0 (f->name));
                 r->check = cb_list_add (r->check, e1);
             }
         }
     }
 
     if (f->storage == CB_STORAGE_CONSTANT) {
         return CB_VALUE (f->values);
     }
 
     return x;
 
 refsubserr:
     switch (numsubs) {
     case 0:
         cb_error_x (x, _("'%s' cannot be subscripted"), name);
         break;
     case 1:
         cb_error_x (x, _("'%s' requires 1 subscript"), name);
         break;
     default:
         cb_error_x (x, _("'%s' requires %d subscripts"),
                 name, f->indexes);
         break;
     }
     return cb_error_node;
 }

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	cond,
		cb_tree	stmts
	)

Definition at line 5671 of file typeck.c.

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

Referenced by yyparse().

 {
     cb_tree     stmt_lis;
 
     stmt_lis = cb_check_needs_break (stmts);
     return cb_build_if (cond, stmt_lis, NULL, 0);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_index	(	cb_tree	x,
		cb_tree	values,
		const unsigned int	indexed_by,
		struct cb_field *	qual
	)

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

 {
     struct cb_field *f;
 
     f = CB_FIELD (cb_build_field (x));
     f->usage = CB_USAGE_INDEX;
     cb_validate_field (f);
     if (values) {
         f->values = CB_LIST_INIT (values);
     }
     if (qual) {
         f->index_qual = qual;
     }
     f->flag_indexed_by = !!indexed_by;
     CB_FIELD_ADD (current_program->working_storage, f);
     return x;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_inspect_region_start ( void )

Definition at line 5961 of file typeck.c.

References CB_BUILD_FUNCALL_0, and CB_LIST_INIT.

Referenced by yyparse().

 {
     return CB_LIST_INIT (CB_BUILD_FUNCALL_0 ("cob_inspect_start"));
 }

Here is the caller graph for this function:

cb_tree cb_build_length ( cb_tree x )

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

 {
     struct cb_field     *f;
     struct cb_literal   *l;
     cb_tree         temp;
     char            buff[32];
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
     if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) {
         return cb_error_node;
     }
 
     if (CB_LITERAL_P (x)) {
         l = CB_LITERAL (x);
         sprintf (buff, "%d", (int)l->size);
         return cb_build_numeric_literal (0, buff, 0);
     }
     if (CB_INTRINSIC_P (x)) {
         return cb_build_any_intrinsic (CB_LIST_INIT (x));
     }
     if (CB_REF_OR_FIELD_P (x)) {
         if (CB_REFERENCE_P (x) && CB_REFERENCE (x)->offset) {
             return cb_build_any_intrinsic (CB_LIST_INIT (x));
         }
         f = CB_FIELD (cb_ref (x));
         if (f->flag_any_length) {
             return cb_build_any_intrinsic (CB_LIST_INIT (x));
         }
         if (cb_field_variable_size (f) == NULL) {
             sprintf (buff, "%d", cb_field_size (x));
             return cb_build_numeric_literal (0, buff, 0);
         }
     }
     temp = cb_build_index (cb_build_filler (), NULL, 0, NULL);
     CB_FIELD (cb_ref (temp))->usage = CB_USAGE_LENGTH;
     CB_FIELD (cb_ref (temp))->count++;
     cb_emit (cb_build_assign (temp, cb_build_length_1 (x)));
     return temp;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_length_1 ( cb_tree x )

static

Definition at line 1696 of file typeck.c.

References cb_build_binary_op(), cb_build_field_reference(), CB_FIELD, cb_field_size(), cb_field_variable_size(), cb_int(), cb_ref(), cb_field::children, cb_field::depending, cb_field::flag_odo_relative, NULL, cb_field::occurs_max, cb_field::sister, and cb_field::size.

Referenced by cb_build_length().

 {
     struct cb_field *f;
     cb_tree     e;
     cb_tree     size;
 
     f = CB_FIELD (cb_ref (x));
 
     if (cb_field_variable_size (f) == NULL) {
         /* Constant size */
         return cb_int (cb_field_size (x));
     }
     /* Variable size */
     e = NULL;
     for (f = f->children; f; f = f->sister) {
         size = cb_build_length_1 (cb_build_field_reference (f, x));
         if (f->depending) {
             if (!cb_flag_odoslide && f->flag_odo_relative) {
                 size = cb_build_binary_op (size, '*',
                                cb_int (f->occurs_max));
             } else {
                 size = cb_build_binary_op (size, '*',
                                f->depending);
             }
         } else if (f->occurs_max > 1) {
             size = cb_build_binary_op (size, '*',
                            cb_int (f->occurs_max));
         }
         e = e ? cb_build_binary_op (e, '+', size) : size;
     }
     return e;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_memset	(	cb_tree	x,
		const int	c
	)

static

Definition at line 6726 of file typeck.c.

References CB_BUILD_CAST_ADDRESS, CB_BUILD_CAST_LENGTH, CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_3, cb_field_size(), cb_int(), and cb_literal::size.

Referenced by cb_build_move_high(), cb_build_move_low(), cb_build_move_num_zero(), cb_build_move_quote(), cb_build_move_space(), and cb_build_move_zero().

 {
     int size = cb_field_size (x);
 
     if (size == 1) {
         return CB_BUILD_FUNCALL_2 ("$E", x, cb_int (c));
     }
     return CB_BUILD_FUNCALL_3 ("memset",
                    CB_BUILD_CAST_ADDRESS (x),
                    cb_int (c), CB_BUILD_CAST_LENGTH (x));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_move	(	cb_tree	src,
		cb_tree	dst
	)

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

 {
     struct cb_reference *x;
 
     if (src == cb_error_node || dst == cb_error_node) {
         return cb_error_node;
     }
 
     if (validate_move (src, dst, 0) < 0) {
         return cb_error_node;
     }
 
 #if 0   /* Flag receiving */
     if (CB_REFERENCE_P (src)) {
         CB_REFERENCE (src)->flag_receiving = 0;
     }
 #endif
 
     if (CB_REFERENCE_P (dst)) {
         /* Clone reference */
         x = cobc_parse_malloc (sizeof(struct cb_reference));
         *x = *CB_REFERENCE (dst);
         x->flag_receiving = 1;
         dst = CB_TREE (x);
     }
 
     if ((src == cb_space || src == cb_low ||
          src == cb_high || src == cb_quote) &&
         (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
          CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED)) {
         src = cb_zero;
     }
 
     if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER ||
         CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
         return cb_build_assign (dst, src);
     }
 
     if (CB_REFERENCE_P (src) &&
         CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) {
         return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
     }
     if (CB_INDEX_P (dst)) {
         if (src == cb_null) {
             return cb_build_assign (dst, cb_zero);
         }
         return cb_build_assign (dst, src);
     }
 
     if (CB_INDEX_P (src)) {
         return CB_BUILD_FUNCALL_2 ("cob_set_int", dst,
                        cb_build_cast_int (src));
     }
 
     if (CB_INTRINSIC_P (src) || CB_INTRINSIC_P (dst)) {
         return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
     }
 
     if (CB_REFERENCE_P (src) && CB_REFERENCE (src)->check) {
         return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
     }
     if (CB_REFERENCE_P (dst) && CB_REFERENCE (dst)->check) {
         return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
     }
 
     /* Output optimal code */
     if (src == cb_zero) {
         return cb_build_move_zero (dst);
     } else if (src == cb_space) {
         return cb_build_move_space (dst);
     } else if (src == cb_high) {
         return cb_build_move_high (dst);
     } else if (src == cb_low) {
         return cb_build_move_low (dst);
     } else if (src == cb_quote) {
         return cb_build_move_quote (dst);
     } else if (CB_LITERAL_P (src)) {
         return cb_build_move_literal (src, dst);
     }
     return cb_build_move_field (src, dst);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_copy	(	cb_tree	src,
		cb_tree	dst
	)

static

Definition at line 6739 of file typeck.c.

References CB_BUILD_CAST_ADDRESS, CB_BUILD_CAST_LENGTH, CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_3, CB_FIELD_PTR, cb_field_size(), CB_STORAGE_LINKAGE, overlapping, and cb_literal::size.

Referenced by cb_build_move_field().

 {
     int size;
 
     size = cb_field_size (dst);
     if (size == 1) {
         return CB_BUILD_FUNCALL_2 ("$F", dst, src);
     }
     if (overlapping
     || CB_FIELD_PTR (src)->storage == CB_STORAGE_LINKAGE
     || CB_FIELD_PTR (dst)->storage == CB_STORAGE_LINKAGE
     || CB_FIELD_PTR (src)->flag_item_based
     || CB_FIELD_PTR (dst)->flag_item_based) {
         overlapping = 0;
         return CB_BUILD_FUNCALL_3 ("memmove",
                        CB_BUILD_CAST_ADDRESS (dst),
                        CB_BUILD_CAST_ADDRESS (src),
                        CB_BUILD_CAST_LENGTH (dst));
     } else {
         return CB_BUILD_FUNCALL_3 ("memcpy",
                        CB_BUILD_CAST_ADDRESS (dst),
                        CB_BUILD_CAST_ADDRESS (src),
                        CB_BUILD_CAST_LENGTH (dst));
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_field	(	cb_tree	src,
		cb_tree	dst
	)

static

Definition at line 7271 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_build_move_copy(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NUMERIC, CB_FIELD_PTR, cb_field_size(), cb_field_variable_size(), CB_TREE_CATEGORY, CB_USAGE_DISPLAY, cb_picture::digits, cb_field::flag_any_length, cb_field::flag_binary_swap, cb_field::flag_justified, cb_field::flag_sign_leading, cb_field::flag_sign_separate, cb_picture::have_sign, cb_field::pic, cb_picture::scale, cb_picture::size, and cb_field::usage.

Referenced by cb_build_move().

 {
     struct cb_field *src_f;
     struct cb_field *dst_f;
     int     src_size;
     int     dst_size;
 
     src_f = CB_FIELD_PTR (src);
     src_size = cb_field_size (src);
     dst_f = CB_FIELD_PTR (dst);
     dst_size = cb_field_size (dst);
 
     if (dst_f->flag_any_length || src_f->flag_any_length) {
         return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
     }
     if (src_size > 0 && dst_size > 0 && src_size >= dst_size &&
         !cb_field_variable_size (src_f) &&
         !cb_field_variable_size (dst_f)) {
         switch (CB_TREE_CATEGORY (src)) {
         case CB_CATEGORY_ALPHABETIC:
             if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC ||
                 CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC) {
                 if (dst_f->flag_justified == 0) {
                     return cb_build_move_copy (src, dst);
                 }
             }
             break;
         case CB_CATEGORY_ALPHANUMERIC:
             if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC) {
                 if (dst_f->flag_justified == 0) {
                     return cb_build_move_copy (src, dst);
                 }
             }
             break;
         case CB_CATEGORY_NUMERIC:
             if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC &&
                 src_f->usage == dst_f->usage &&
                 src_f->pic->size == dst_f->pic->size &&
                 src_f->pic->digits == dst_f->pic->digits &&
                 src_f->pic->scale == dst_f->pic->scale &&
                 src_f->pic->have_sign == dst_f->pic->have_sign &&
                 src_f->flag_binary_swap == dst_f->flag_binary_swap &&
                 src_f->flag_sign_leading == dst_f->flag_sign_leading &&
                 src_f->flag_sign_separate == dst_f->flag_sign_separate) {
                 return cb_build_move_copy (src, dst);
             } else if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC
                  && src_f->usage == CB_USAGE_DISPLAY
                  && src_f->pic->have_sign == 0
                  && !src_f->flag_sign_leading
                  && !src_f->flag_sign_separate) {
                 return cb_build_move_copy (src, dst);
             }
             break;
         default:
             break;
         }
     }
 
     return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_high ( cb_tree x )

static

Definition at line 6866 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_build_memset(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NUMERIC, CB_FIELD_PTR, cb_high, cb_norm_high, CB_TREE_CATEGORY, and cb_field::flag_any_length.

Referenced by cb_build_move().

 {
     switch (CB_TREE_CATEGORY (x)) {
     case CB_CATEGORY_NUMERIC:
     case CB_CATEGORY_ALPHABETIC:
     case CB_CATEGORY_ALPHANUMERIC:
         if (CB_FIELD_PTR (x)->flag_any_length) {
             return CB_BUILD_FUNCALL_2 ("cob_move", cb_high, x);
         }
         if (cb_high == cb_norm_high) {
             return cb_build_memset (x, 255);
         }
         /* Fall through */
     default:
         return CB_BUILD_FUNCALL_2 ("cob_move", cb_high, x);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_literal	(	cb_tree	src,
		cb_tree	dst
	)

static

Definition at line 7038 of file typeck.c.

References cb_literal::all, cb_build_assign(), CB_BUILD_CAST_ADDRESS, CB_BUILD_CAST_LENGTH, cb_build_cast_llint(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_3, cb_build_move_num_zero(), cb_build_string(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, CB_FIELD_PTR, cb_field_variable_size(), cb_fits_int(), cb_get_int(), cb_int(), CB_LITERAL, CB_STORAGE_LINKAGE, CB_TREE_CATEGORY, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_6, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_PACKED, cob_put_sign_ascii(), cob_put_sign_ebcdic(), cobc_parse_free(), cobc_parse_malloc(), cb_literal::data, cb_field::flag_binary_swap, cb_field::flag_blank_zero, cb_field::flag_justified, cb_field::flag_sign_leading, cb_field::flag_sign_separate, cb_picture::have_sign, cb_field::indexes, cb_field::offset, optim_table::optim_val, optimize_defs, cb_field::pic, cb_literal::scale, cb_picture::scale, cb_literal::sign, cb_literal::size, cb_field::size, cb_field::storage, and cb_field::usage.

Referenced by cb_build_move().

 {
     struct cb_literal   *l;
     struct cb_field     *f;
     unsigned char       *buff;
     unsigned char       *p;
     enum cb_category    cat;
     int         i;
     int         diff;
     int         val;
     int         n;
     unsigned char       bbyte;
 
     l = CB_LITERAL (src);
     f = CB_FIELD_PTR (dst);
     cat = CB_TREE_CATEGORY (dst);
 
     if (l->all) {
         if (cat == CB_CATEGORY_NUMERIC ||
             cat == CB_CATEGORY_NUMERIC_EDITED) {
             return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
         }
         if (l->size == 1) {
             return CB_BUILD_FUNCALL_3 ("memset",
                        CB_BUILD_CAST_ADDRESS (dst),
                        cb_int (l->data[0]),
                        CB_BUILD_CAST_LENGTH (dst));
         }
         bbyte = l->data[0];
         for (i = 0; i < (int)l->size; i++) {
             if (bbyte != l->data[i]) {
                 break;
             }
             bbyte = l->data[i];
         }
         if (i == (int)l->size) {
             return CB_BUILD_FUNCALL_3 ("memset",
                        CB_BUILD_CAST_ADDRESS (dst),
                        cb_int (l->data[0]),
                        CB_BUILD_CAST_LENGTH (dst));
         }
         if (f->size > 128) {
             return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
         }
         buff = cobc_parse_malloc ((size_t)f->size);
         for (i = 0; i < f->size; i++) {
             buff[i] = l->data[i % l->size];
         }
         return CB_BUILD_FUNCALL_3 ("memcpy",
                        CB_BUILD_CAST_ADDRESS (dst),
                        cb_build_string (buff, (size_t)f->size),
                        CB_BUILD_CAST_LENGTH (dst));
     }
 
     if (cat == CB_CATEGORY_NUMERIC_EDITED) {
         return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
     }
 
     if ((cat == CB_CATEGORY_NUMERIC &&
         f->usage == CB_USAGE_DISPLAY &&
         f->pic->scale == l->scale &&
         !f->flag_sign_leading && !f->flag_sign_separate &&
         !f->flag_blank_zero) ||
        ((cat == CB_CATEGORY_ALPHABETIC ||
          cat == CB_CATEGORY_ALPHANUMERIC) &&
         f->size < (int) (l->size + 16) &&
         !cb_field_variable_size (f))) {
         buff = cobc_parse_malloc ((size_t)f->size);
         diff = (int) (f->size - l->size);
         if (cat == CB_CATEGORY_NUMERIC) {
             if (diff <= 0) {
                 memcpy (buff, l->data - diff, (size_t)f->size);
             } else {
                 memset (buff, '0', (size_t)diff);
                 memcpy (buff + diff, l->data, (size_t)l->size);
             }
             /* Check all zeros */
             n = 0;
             for (p = buff; p < buff + f->size; p++) {
                 if (*p != '0') {
                     n = 1;
                     break;
                 }
             }
             if (f->pic->have_sign) {
                 p = &buff[f->size - 1];
                 if (!n) {
                     /* Zeros */
                     /* EBCDIC - store sign otherwise nothing */
                     if (cb_ebcdic_sign) {
                         cob_put_sign_ebcdic (p, 1);
                     }
                 } else if (cb_ebcdic_sign) {
                     cob_put_sign_ebcdic (p, l->sign);
                 } else if (l->sign < 0) {
 #ifdef  COB_EBCDIC_MACHINE
                     cob_put_sign_ascii (p);
 #else
                     *p += 0x40;
 #endif
                 }
             }
         } else {
             if (f->flag_justified) {
                 if (diff <= 0) {
                     memcpy (buff, l->data - diff, (size_t)f->size);
                 } else {
                     memset (buff, ' ', (size_t)diff);
                     memcpy (buff + diff, l->data, (size_t)l->size);
                 }
             } else {
                 if (diff <= 0) {
                     memcpy (buff, l->data, (size_t)f->size);
                 } else {
                     memcpy (buff, l->data, (size_t)l->size);
                     memset (buff + l->size, ' ', (size_t)diff);
                 }
             }
         }
         bbyte = *buff;
         if (f->size == 1) {
             cobc_parse_free (buff);
             return CB_BUILD_FUNCALL_2 ("$E", dst, cb_int (bbyte));
         }
         for (i = 0; i < f->size; i++) {
             if (bbyte != buff[i]) {
                 break;
             }
         }
         if (i == f->size) {
             cobc_parse_free (buff);
             return CB_BUILD_FUNCALL_3 ("memset",
                        CB_BUILD_CAST_ADDRESS (dst),
                        cb_int (bbyte),
                        CB_BUILD_CAST_LENGTH (dst));
         }
         return CB_BUILD_FUNCALL_3 ("memcpy",
                        CB_BUILD_CAST_ADDRESS (dst),
                        cb_build_string (buff, (size_t)f->size),
                        CB_BUILD_CAST_LENGTH (dst));
     }
 
     if ((f->usage == CB_USAGE_BINARY ||
         f->usage == CB_USAGE_COMP_5 ||
         f->usage == CB_USAGE_COMP_X) &&
         cb_fits_int (src) && f->size <= 8) {
         val = cb_get_int (src);
         n = f->pic->scale - l->scale;
         if ((l->size + n) > 9) {
             return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
         }
         for (; n > 0; n--) {
             val *= 10;
         }
         for (; n < 0; n++) {
             val /= 10;
         }
         if (val == 0) {
             return cb_build_move_num_zero (dst);
         }
         if (val < 0 && !f->pic->have_sign) {
             val = -val;
         }
         if (f->size == 1) {
             return cb_build_assign (dst, cb_int (val));
         }
         if (f->flag_binary_swap) {
             i = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0));
             optimize_defs[bin_set_funcs[i].optim_val] = 1;
             return CB_BUILD_FUNCALL_2 (bin_set_funcs[i].optim_name,
                 CB_BUILD_CAST_ADDRESS (dst),
                 cb_int (val));
         }
         switch (f->size) {
         case 2:
 #ifdef  COB_SHORT_BORK
             if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 &&
                (f->offset % 4 == 0)) {
                 return cb_build_assign (dst, cb_int (val));
             }
             break;
 #endif
         case 4:
         case 8:
 #ifdef  COB_NON_ALIGNED
             if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 &&
                (f->offset % f->size == 0)) {
                 return cb_build_assign (dst, cb_int (val));
             }
             break;
 #else
             return cb_build_assign (dst, cb_int (val));
 #endif
         default:
             break;
         }
         return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
     }
 
     if ((f->usage == CB_USAGE_PACKED || f->usage == CB_USAGE_COMP_6) &&
         cb_fits_int (src)) {
         if (f->pic->scale < 0) {
             return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
         }
         val = cb_get_int (src);
         n = f->pic->scale - l->scale;
         if ((l->size + n) > 9) {
             return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
         }
         for (; n > 0; n--) {
             val *= 10;
         }
         for (; n < 0; n++) {
             val /= 10;
         }
         if (val == 0) {
             return cb_build_move_num_zero (dst);
         }
         if (val < 0 && !f->pic->have_sign) {
             val = -val;
         }
 #if 1   /* RXWRXW - Set packed */
         return CB_BUILD_FUNCALL_2 ("cob_set_packed_int", dst,
                        cb_int (val));
 #else
         return CB_BUILD_FUNCALL_2 ("cob_set_packed_int", dst,
                        cb_build_cast_llint (src));
 #endif
     }
     return CB_BUILD_FUNCALL_2 ("cob_move", src, dst);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_low ( cb_tree x )

static

Definition at line 6885 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_build_memset(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NUMERIC, CB_FIELD_PTR, cb_low, cb_norm_low, CB_TREE_CATEGORY, and cb_field::flag_any_length.

Referenced by cb_build_move().

 {
     switch (CB_TREE_CATEGORY (x)) {
     case CB_CATEGORY_NUMERIC:
     case CB_CATEGORY_ALPHABETIC:
     case CB_CATEGORY_ALPHANUMERIC:
         if (CB_FIELD_PTR (x)->flag_any_length) {
             return CB_BUILD_FUNCALL_2 ("cob_move", cb_low, x);
         }
         if (cb_low == cb_norm_low) {
             return cb_build_memset (x, 0);
         }
         /* Fall through */
     default:
         return CB_BUILD_FUNCALL_2 ("cob_move", cb_low, x);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_num_zero ( cb_tree x )

static

Definition at line 6766 of file typeck.c.

References cb_build_assign(), CB_BUILD_FUNCALL_1, CB_BUILD_FUNCALL_2, cb_build_memset(), CB_FIELD_PTR, cb_int0, CB_STORAGE_LINKAGE, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_6, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_PACKED, cb_zero, cb_field::flag_binary_swap, cb_picture::have_sign, cb_field::indexes, cb_field::offset, cb_field::pic, cb_field::size, cb_field::storage, and cb_field::usage.

Referenced by cb_build_move_literal(), and cb_build_move_zero().

 {
     struct cb_field     *f;
 
     f = CB_FIELD_PTR (x);
     switch (f->usage) {
     case CB_USAGE_BINARY:
     case CB_USAGE_COMP_5:
     case CB_USAGE_COMP_X:
         if (f->flag_binary_swap) {
             return cb_build_memset (x, 0);
         }
         switch (f->size) {
 #ifdef  COB_NON_ALIGNED
         case 1:
             return cb_build_assign (x, cb_int0);
         case 2:
 #ifdef  COB_SHORT_BORK
             if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 &&
                (f->offset % 4 == 0)) {
                 return cb_build_assign (x, cb_int0);
             }
             break;
 #endif
         case 4:
         case 8:
             if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 &&
                (f->offset % f->size == 0)) {
                 return cb_build_assign (x, cb_int0);
             }
             break;
 #else
         case 1:
         case 2:
         case 4:
         case 8:
             return cb_build_assign (x, cb_int0);
 #endif
         default:
             break;
         }
         return cb_build_memset (x, 0);
     case CB_USAGE_DISPLAY:
         if (!cb_ebcdic_sign) {
             return cb_build_memset (x, '0');
         }
         if (f->pic && !f->pic->have_sign) {
             return cb_build_memset (x, '0');
         }
         break;
     case CB_USAGE_PACKED:
         return CB_BUILD_FUNCALL_1 ("cob_set_packed_zero", x);
     case CB_USAGE_COMP_6:
         return cb_build_memset (x, 0);
     default:
         break;
     }
     return CB_BUILD_FUNCALL_2 ("cob_move", cb_zero, x);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_quote ( cb_tree x )

static

Definition at line 6904 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_build_memset(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NUMERIC, CB_FIELD_PTR, cb_quote, CB_TREE_CATEGORY, and cb_field::flag_any_length.

Referenced by cb_build_move().

 {
     switch (CB_TREE_CATEGORY (x)) {
     case CB_CATEGORY_NUMERIC:
     case CB_CATEGORY_ALPHABETIC:
     case CB_CATEGORY_ALPHANUMERIC:
         if (!CB_FIELD_PTR (x)->flag_any_length) {
             return cb_build_memset (x, cb_flag_apostrophe ? '\'' : '"');
         }
         /* Fall through */
     default:
         return CB_BUILD_FUNCALL_2 ("cob_move", cb_quote, x);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_space ( cb_tree x )

static

Definition at line 6827 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_build_memset(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NUMERIC, CB_FIELD_PTR, cb_space, CB_TREE_CATEGORY, and cb_field::flag_any_length.

Referenced by cb_build_move(), and cb_build_move_zero().

 {
     switch (CB_TREE_CATEGORY (x)) {
     case CB_CATEGORY_NUMERIC:
     case CB_CATEGORY_ALPHABETIC:
     case CB_CATEGORY_ALPHANUMERIC:
         if (!CB_FIELD_PTR (x)->flag_any_length) {
             return cb_build_memset (x, ' ');
         }
         /* Fall through */
     default:
         return CB_BUILD_FUNCALL_2 ("cob_move", cb_space, x);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_move_zero ( cb_tree x )

static

Definition at line 6843 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_build_memset(), cb_build_move_num_zero(), cb_build_move_space(), CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_CATEGORY_NUMERIC, CB_FIELD_PTR, CB_TREE_CATEGORY, cb_zero, cb_field::flag_any_length, cb_field::flag_blank_zero, and cb_field::flag_sign_separate.

Referenced by cb_build_move().

 {
     switch (CB_TREE_CATEGORY (x)) {
     case CB_CATEGORY_NUMERIC:
         if (CB_FIELD_PTR (x)->flag_blank_zero) {
             return cb_build_move_space (x);
         } else if (CB_FIELD_PTR (x)->flag_sign_separate) {
             return CB_BUILD_FUNCALL_2 ("cob_move", cb_zero, x);
         } else {
             return cb_build_move_num_zero (x);
         }
     case CB_CATEGORY_ALPHABETIC:
     case CB_CATEGORY_ALPHANUMERIC:
         if (!CB_FIELD_PTR (x)->flag_any_length) {
             return cb_build_memset (x, '0');
         }
         /* Fall through */
     default:
         return CB_BUILD_FUNCALL_2 ("cob_move", cb_zero, x);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_mul	(	cb_tree	v,
		cb_tree	n,
		cb_tree	round_opt
	)

static

Definition at line 3368 of file typeck.c.

References build_store_option(), cb_build_binary_op(), CB_BUILD_FUNCALL_3, cb_build_move(), CB_FIELD_PTR, CB_INDEX_P, CB_REF_OR_FIELD_P, and cb_field::count.

Referenced by cb_emit_arithmetic().

 {
     cb_tree     opt;
     struct cb_field *f;
 
     if (CB_INDEX_P (v)) {
         return cb_build_move (cb_build_binary_op (v, '*', n), v);
     }
 
     if (CB_REF_OR_FIELD_P (v)) {
         f = CB_FIELD_PTR (v);
         f->count++;
     }
     if (CB_REF_OR_FIELD_P (n)) {
         f = CB_FIELD_PTR (n);
         f->count++;
     }
     opt = build_store_option (v, round_opt);
     return CB_BUILD_FUNCALL_3 ("cob_mul", v, n, opt);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_optim_add	(	cb_tree	v,
		cb_tree	n
	)

static

Definition at line 3876 of file typeck.c.

References cb_build_assign(), cb_build_binary_op(), CB_BUILD_CAST_ADDRESS, cb_build_cast_int(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_3, CB_FIELD_PTR, cb_int0, CB_REF_OR_FIELD_P, CB_STORAGE_LINKAGE, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_X, CB_USAGE_PACKED, COB_ADD_PACKED_INT, cb_picture::digits, cb_field::flag_binary_swap, cb_picture::have_sign, cb_field::indexes, cb_field::offset, optim_table::optim_val, optimize_defs, cb_field::pic, cb_picture::scale, cb_field::size, cb_field::storage, and cb_field::usage.

Referenced by cb_build_add().

 {
     size_t      z;
     const char  *s;
     struct cb_field *f;
 
     if (CB_REF_OR_FIELD_P (v)) {
         f = CB_FIELD_PTR (v);
         if (!f->pic) {
             return CB_BUILD_FUNCALL_3 ("cob_add_int", v,
                            cb_build_cast_int (n),
                            cb_int0);
         }
         if (!f->pic->scale && (f->usage == CB_USAGE_BINARY ||
             f->usage == CB_USAGE_COMP_5 ||
             f->usage == CB_USAGE_COMP_X)) {
             z = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)) +
                 (16 * (f->flag_binary_swap ? 1 : 0));
 #if defined(COB_NON_ALIGNED) && !defined(_MSC_VER)
             switch (f->size) {
             case 2:
 #ifdef  COB_SHORT_BORK
                 optimize_defs[bin_add_funcs[z].optim_val] = 1;
                 s = bin_add_funcs[z].optim_name;
                 break;
 #endif
             case 4:
             case 8:
                 if (f->storage != CB_STORAGE_LINKAGE &&
                     f->indexes == 0 &&
                     (f->offset % f->size) == 0) {
                     optimize_defs[align_bin_add_funcs[z].optim_val] = 1;
                     s = align_bin_add_funcs[z].optim_name;
                 } else {
                     optimize_defs[bin_add_funcs[z].optim_val] = 1;
                     s = bin_add_funcs[z].optim_name;
                 }
                 break;
             default:
                 optimize_defs[bin_add_funcs[z].optim_val] = 1;
                 s = bin_add_funcs[z].optim_name;
                 break;
             }
 #else
             if (f->usage == CB_USAGE_COMP_5) {
                 switch (f->size) {
                 case 1:
                 case 2:
                 case 4:
                 case 8:
                     return cb_build_assign (v, cb_build_binary_op (v, '+', n));
                 default:
                     break;
                 }
             }
             optimize_defs[bin_add_funcs[z].optim_val] = 1;
             s = bin_add_funcs[z].optim_name;
 #endif
             if (s) {
                 return CB_BUILD_FUNCALL_2 (s,
                     CB_BUILD_CAST_ADDRESS (v),
                     cb_build_cast_int (n));
             }
         } else if (!f->pic->scale && f->usage == CB_USAGE_PACKED &&
                f->pic->digits < 10) {
             optimize_defs[COB_ADD_PACKED_INT] = 1;
             return CB_BUILD_FUNCALL_2 ("cob_add_packed_int",
                 v, cb_build_cast_int (n));
         }
     }
     return CB_BUILD_FUNCALL_3 ("cob_add_int", v,
                    cb_build_cast_int (n), cb_int0);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_optim_cond ( struct cb_binary_op * p )

static

Definition at line 3558 of file typeck.c.

References CB_BUILD_CAST_ADDRESS, cb_build_cast_int(), cb_build_cast_llint(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_4, CB_FIELD_PTR, cb_fits_long_long(), cb_int(), CB_REF_OR_FIELD_P, CB_STORAGE_LINKAGE, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_6, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_INDEX, CB_USAGE_PACKED, COB_CMP_PACKED_INT, cb_picture::digits, cb_field::flag_any_numeric, cb_field::flag_binary_swap, cb_field::flag_sign_leading, cb_field::flag_sign_separate, cb_picture::have_sign, cb_field::indexes, cb_field::offset, optim_table::optim_val, optimize_defs, cb_field::pic, cb_picture::scale, cb_field::size, cb_field::special_index, cb_field::storage, cb_field::usage, cb_binary_op::x, and cb_binary_op::y.

Referenced by cb_build_cond().

 {
     struct cb_field *f;
     const char  *s;
     size_t      n;
 
 #if 0   /* RXWRXW - US */
     struct cb_field *fy;
     if (CB_REF_OR_FIELD_P (p->y)) {
         fy = CB_FIELD_PTR (p->y);
         if (!fy->pic->have_sign && (fy->usage == CB_USAGE_BINARY ||
             fy->usage == CB_USAGE_COMP_5 ||
             fy->usage == CB_USAGE_COMP_X)) {
             return CB_BUILD_FUNCALL_2 ("cob_cmp_uint", p->x,
                            cb_build_cast_int (p->y));
         }
     }
 #endif
 
     if (!CB_REF_OR_FIELD_P (p->x)) {
         return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x,
                         cb_build_cast_llint (p->y));
     }
 
     f = CB_FIELD_PTR (p->x);
 #if 0   /* RXWRXW - SI */
     if (f->special_index) {
         return CB_BUILD_FUNCALL_2 ("cob_cmp_special",
             cb_build_cast_int (p->x),
             cb_build_cast_int (p->y));
     }
 #endif
     if (f->pic->scale || f->flag_any_numeric) {
         return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x,
                         cb_build_cast_llint (p->y));
     }
     if (f->usage == CB_USAGE_PACKED) {
         if (f->pic->digits < 19) {
             optimize_defs[COB_CMP_PACKED_INT] = 1;
             return CB_BUILD_FUNCALL_2 ("cob_cmp_packed_int",
                 p->x,
                 cb_build_cast_llint (p->y));
         } else {
             return CB_BUILD_FUNCALL_2 ("cob_cmp_packed",
                 p->x,
                 cb_build_cast_llint (p->y));
         }
     }
     if (f->usage == CB_USAGE_COMP_6) {
         return CB_BUILD_FUNCALL_2 ("cob_cmp_packed",
             p->x,
             cb_build_cast_llint (p->y));
     }
     if (f->usage == CB_USAGE_DISPLAY &&
         !f->flag_sign_leading && !f->flag_sign_separate) {
         if (cb_fits_long_long (p->x)) {
             return CB_BUILD_FUNCALL_4 ("cob_cmp_numdisp",
                 CB_BUILD_CAST_ADDRESS (p->x),
                 cb_int (f->size),
                 cb_build_cast_llint (p->y),
                 cb_int (f->pic->have_sign ? 1 : 0));
         }
         return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x,
                         cb_build_cast_llint (p->y));
     }
     if (f->usage == CB_USAGE_BINARY ||
         f->usage == CB_USAGE_COMP_5 ||
         f->usage == CB_USAGE_INDEX ||
         f->usage == CB_USAGE_COMP_X) {
         n = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)) +
             (16 * (f->flag_binary_swap ? 1 : 0));
 #if defined(COB_NON_ALIGNED) && !defined(_MSC_VER)
         switch (f->size) {
         case 2:
 #ifdef  COB_SHORT_BORK
             optimize_defs[bin_compare_funcs[n].optim_val] = 1;
             s = bin_compare_funcs[n].optim_name;
             break;
 #endif
         case 4:
         case 8:
             if (f->storage != CB_STORAGE_LINKAGE &&
                 f->indexes == 0 && (f->offset % f->size) == 0) {
                 optimize_defs[align_bin_compare_funcs[n].optim_val] = 1;
                 s = align_bin_compare_funcs[n].optim_name;
             } else {
                 optimize_defs[bin_compare_funcs[n].optim_val] = 1;
                 s = bin_compare_funcs[n].optim_name;
             }
             break;
         default:
             optimize_defs[bin_compare_funcs[n].optim_val] = 1;
             s = bin_compare_funcs[n].optim_name;
             break;
         }
 #else
         optimize_defs[bin_compare_funcs[n].optim_val] = 1;
         s = bin_compare_funcs[n].optim_name;
 #endif
         if (s) {
             return CB_BUILD_FUNCALL_2 (s,
                 CB_BUILD_CAST_ADDRESS (p->x),
                 cb_build_cast_llint (p->y));
         }
     }
     return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x,
                    cb_build_cast_llint (p->y));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_optim_sub	(	cb_tree	v,
		cb_tree	n
	)

static

Definition at line 3951 of file typeck.c.

References cb_build_assign(), cb_build_binary_op(), CB_BUILD_CAST_ADDRESS, cb_build_cast_int(), CB_BUILD_FUNCALL_2, CB_BUILD_FUNCALL_3, CB_FIELD_PTR, cb_int0, CB_REF_OR_FIELD_P, CB_STORAGE_LINKAGE, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_X, cb_field::flag_binary_swap, cb_picture::have_sign, cb_field::indexes, cb_field::offset, optim_table::optim_val, optimize_defs, cb_field::pic, cb_picture::scale, cb_field::size, cb_field::storage, and cb_field::usage.

Referenced by cb_build_sub().

 {
     size_t      z;
     const char  *s;
     struct cb_field *f;
 
     if (CB_REF_OR_FIELD_P (v)) {
         f = CB_FIELD_PTR (v);
         if (!f->pic->scale && (f->usage == CB_USAGE_BINARY ||
             f->usage == CB_USAGE_COMP_5 ||
             f->usage == CB_USAGE_COMP_X)) {
             z = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)) +
                 (16 * (f->flag_binary_swap ? 1 : 0));
 #if defined(COB_NON_ALIGNED) && !defined(_MSC_VER)
             switch (f->size) {
             case 2:
 #ifdef  COB_SHORT_BORK
                 optimize_defs[bin_sub_funcs[z].optim_val] = 1;
                 s = bin_sub_funcs[z].optim_name;
                 break;
 #endif
             case 4:
             case 8:
                 if (f->storage != CB_STORAGE_LINKAGE &&
                     f->indexes == 0 && (f->offset % f->size) == 0) {
                     optimize_defs[align_bin_sub_funcs[z].optim_val] = 1;
                     s = align_bin_sub_funcs[z].optim_name;
                 } else {
                     optimize_defs[bin_sub_funcs[z].optim_val] = 1;
                     s = bin_sub_funcs[z].optim_name;
                 }
                 break;
             default:
                 optimize_defs[bin_sub_funcs[z].optim_val] = 1;
                 s = bin_sub_funcs[z].optim_name;
                 break;
             }
 #else
             if (f->usage == CB_USAGE_COMP_5) {
                 switch (f->size) {
                 case 1:
                 case 2:
                 case 4:
                 case 8:
                     return cb_build_assign (v, cb_build_binary_op (v, '-', n));
                 default:
                     break;
                 }
             }
             optimize_defs[bin_sub_funcs[z].optim_val] = 1;
             s = bin_sub_funcs[z].optim_name;
 #endif
             if (s) {
                 return CB_BUILD_FUNCALL_2 (s,
                     CB_BUILD_CAST_ADDRESS (v),
                     cb_build_cast_int (n));
             }
         }
     }
     return CB_BUILD_FUNCALL_3 ("cob_sub_int", v,
                    cb_build_cast_int (n), cb_int0);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_exit ( struct cb_label * label )

Definition at line 7574 of file typeck.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_forever ( cb_tree body )

Definition at line 7561 of file typeck.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_once ( cb_tree body )

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_times ( cb_tree times )

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

 {
     cb_tree     x;
 
     if (cb_check_integer_value (times) == cb_error_node) {
         return cb_error_node;
     }
 
     x = cb_build_perform (CB_PERFORM_TIMES);
     CB_PERFORM (x)->data = times;
     return x;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_perform_until	(	cb_tree	condition,
		cb_tree	varying
	)

Definition at line 7550 of file typeck.c.

References cb_build_perform(), CB_PERFORM, and CB_PERFORM_UNTIL.

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_ppointer ( cb_tree x )

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

 {
     struct cb_field *f;
 
     if (x == cb_error_node ||
         (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) {
         return cb_error_node;
     }
 
     if (CB_REFERENCE_P (x)) {
         f = CB_FIELD_PTR (cb_ref(x));
         f->count++;
     }
     return CB_BUILD_CAST_PPOINTER (x);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

char* cb_build_program_id	(	cb_tree	name,
		cb_tree	alt_name,
		const cob_u32_t	is_func
	)

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

 {
     const char  *name_str;
     char        *s;
     unsigned char   *p;
 
     /* Set the program name */
     if (CB_LITERAL_P (name)) {
         current_program->program_name = (char *)CB_LITERAL (name)->data;
     } else {
         current_program->program_name = CB_NAME (name);
     }
 
     /* Set and encode the PROGRAM-ID */
     if (alt_name) {
         name_str = (const char *)CB_LITERAL (alt_name)->data;
     } else if (CB_LITERAL_P (name)) {
         name_str = (const char *)CB_LITERAL (name)->data;
     } else {
         name_str = CB_NAME (name);
     }
     current_program->orig_program_id = cobc_strdup (name_str);
     s = cb_encode_program_id (name_str);
 
     (void)cobc_check_valid_name (current_program->orig_program_id, 2U);
 
     /* Convert function names to upper case */
     if (is_func) {
         for (p = (unsigned char *)s; *p; ++p) {
             if (islower ((int)*p)) {
                 *p = (cob_u8_t)toupper ((int)*p);
             }
         }
     }
     return s;
 }

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

 {
 #if !defined(__linux__) && !defined(__CYGWIN__) && defined(HAVE_TIMEZONE)
     long    contz;
 #endif
     cb_tree         r;
     cb_tree     x;
     struct tm   *tlt;
     time_t      t;
     char        buff[48];
 
     /* RETURN-CODE */
     if (!current_program->nested_level) {
         x = cb_build_index (cb_build_reference ("RETURN-CODE"),
                     cb_zero, 0, NULL);
         CB_FIELD_PTR (x)->special_index = 1;
         current_program->cb_return_code = x;
     }
 
     /* SORT-RETURN */
     x = cb_build_index (cb_build_reference ("SORT-RETURN"),
                 cb_zero, 0, NULL);
     CB_FIELD_PTR (x)->flag_no_init = 1;
     current_program->cb_sort_return = x;
 
     /* NUMBER-OF-CALL-PARAMETERS */
     x = cb_build_index (cb_build_reference ("NUMBER-OF-CALL-PARAMETERS"),
                 cb_zero, 0, NULL);
     CB_FIELD_PTR (x)->flag_no_init = 1;
     CB_FIELD_PTR (x)->flag_local = 1;
     CB_FIELD_PTR (x)->special_index = 2;
     current_program->cb_call_params = x;
 
     /* TALLY */
     if (current_program->nested_level == 0) {
         r = cb_build_reference ("TALLY");
         x = cb_build_field (r);
         CB_FIELD_PTR (x)->usage = CB_USAGE_BINARY;
         CB_FIELD_PTR (x)->pic = CB_PICTURE (cb_build_picture ("9(5)"));
         cb_validate_field (CB_FIELD_PTR (x));
         CB_FIELD_PTR (x)->values = CB_LIST_INIT (cb_zero);
         CB_FIELD_PTR (x)->flag_no_init = 1;
         CB_FIELD_PTR (x)->flag_is_global = 1;
         CB_FIELD_ADD (current_program->working_storage, CB_FIELD_PTR (x));
     }
 
     t = time (NULL);
     tlt = localtime (&t);
     /* Leap seconds ? */
     if (tlt->tm_sec >= 60) {
         tlt->tm_sec = 59;
     }
 
     /* WHEN-COMPILED */
     memset (buff, 0, sizeof (buff));
     strftime (buff, (size_t)17, "%m/%d/%y%H.%M.%S", tlt);
     cb_build_constant (cb_build_reference ("WHEN-COMPILED"),
                cb_build_alphanumeric_literal (buff, (size_t)16));
 
     /* FUNCTION WHEN-COMPILED */
     memset (buff, 0, sizeof (buff));
 #if defined(__linux__) || defined(__CYGWIN__)
     strftime (buff, (size_t)22, "%Y%m%d%H%M%S00%z", tlt);
 #elif defined(HAVE_TIMEZONE)
     strftime (buff, (size_t)17, "%Y%m%d%H%M%S00", tlt);
     if (timezone <= 0) {
         contz = -timezone;
         buff[16] = '+';
     } else {
         contz = timezone;
         buff[16] = '-';
     }
     sprintf (&buff[17], "%2.2ld%2.2ld", contz / 3600, contz % 60);
 #else
     strftime (buff, (size_t)22, "%Y%m%d%H%M%S0000000", tlt);
 #endif
     cb_intr_whencomp = cb_build_alphanumeric_literal (buff, (size_t)21);
 
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 5926 of file typeck.c.

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

Referenced by yyparse().

 {
     validate_inspect (x, y, 1);
     return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_all", y, x));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_replacing_characters	(	cb_tree	x,
		cb_tree	l
	)

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

 {
     if (CB_LITERAL_P (x) && CB_LITERAL(x)->size != 1) {
         cb_error_x (CB_TREE (current_statement),
                 _("Operand has wrong size"));
     }
     return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", x));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 5940 of file typeck.c.

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

Referenced by yyparse().

 {
     validate_inspect (x, y, 1);
     return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_first", y, x));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 5933 of file typeck.c.

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

Referenced by yyparse().

 {
     validate_inspect (x, y, 1);
     return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_leading", y, x));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 5947 of file typeck.c.

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

Referenced by yyparse().

 {
     validate_inspect (x, y, 1);
     return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_trailing", y, x));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_build_search_all	(	cb_tree	table,
		cb_tree	cond
	)

static

Definition at line 7923 of file typeck.c.

References cb_build_binary_op(), cb_build_cond(), CB_FIELD_PTR, COB_ASCENDING, cb_key::dir, cb_field::keys, cb_field::nkeys, NULL, cb_key::ref, search_set_keys(), and cb_key::val.

Referenced by cb_emit_search_all().

 {
     cb_tree     c1;
     cb_tree     c2;
     struct cb_field *f;
     int     i;
 
     f = CB_FIELD_PTR (table);
     /* Set keys */
     for (i = 0; i < f->nkeys; i++) {
         f->keys[i].ref = NULL;
     }
     if (search_set_keys (f, cond)) {
         return NULL;
     }
     c1 = NULL;
 
     /* Build condition */
     for (i = 0; i < f->nkeys; i++) {
         if (f->keys[i].ref) {
             if (f->keys[i].dir == COB_ASCENDING) {
                 c2 = cb_build_binary_op (f->keys[i].ref, '=',
                              f->keys[i].val);
             } else {
                 c2 = cb_build_binary_op (f->keys[i].val, '=',
                              f->keys[i].ref);
             }
             if (c1 == NULL) {
                 c1 = c2;
             } else {
                 c1 = cb_build_binary_op (c1, '&', c2);
             }
         }
     }
 
     if (!c1) {
         return NULL;
     }
     return cb_build_cond (c1);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_section_name	(	cb_tree	name,
		const int	sect_or_para
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 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().

 {
     cb_tree     opt;
     struct cb_field *f;
 
 #ifdef  COB_NON_ALIGNED
     if (CB_INDEX_P (v)) {
         return cb_build_move (cb_build_binary_op (v, '-', n), v);
     }
     if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
         optimize_defs[COB_POINTER_MANIP] = 1;
         return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", v, n, cb_int1);
     }
 #else
     if (CB_INDEX_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) {
         return cb_build_move (cb_build_binary_op (v, '-', n), v);
     }
 #endif
 
     if (CB_REF_OR_FIELD_P (v)) {
         f = CB_FIELD_PTR (v);
         f->count++;
     }
     if (CB_REF_OR_FIELD_P (n)) {
         f = CB_FIELD_PTR (n);
         f->count++;
     }
     opt = build_store_option (v, round_opt);
     if (opt == cb_int0 && cb_fits_int (n)) {
         return cb_build_optim_sub (v, n);
     }
     return CB_BUILD_FUNCALL_3 ("cob_sub", v, n, opt);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

 {
     if (inspect_data == NULL) {
         cb_error_x (CB_TREE (current_statement),
                 _("Data name expected before ALL"));
     }
     inspect_func = "cob_inspect_all";
     return NULL;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_characters ( cb_tree l )

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

 {
     if (inspect_data == NULL) {
         cb_error_x (CB_TREE (current_statement),
                 _("Data name expected before CHARACTERS"));
     }
     inspect_func = NULL;
     return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", inspect_data));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_data ( cb_tree x )

Definition at line 5856 of file typeck.c.

References NULL.

Referenced by yyparse().

 {
     inspect_data = x;
     return NULL;
 }

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

 {
     if (inspect_data == NULL) {
         cb_error_x (CB_TREE (current_statement),
                 _("Data name expected before LEADING"));
     }
     inspect_func = "cob_inspect_leading";
     return NULL;
 }

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

 {
     if (inspect_data == NULL) {
         cb_error_x (CB_TREE (current_statement),
                 _("Data name expected before TRAILING"));
     }
     inspect_func = "cob_inspect_trailing";
     return NULL;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_tallying_value	(	cb_tree	x,
		cb_tree	l
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_unstring_delimited	(	cb_tree	all,
		cb_tree	value
	)

Definition at line 8578 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_error_node, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_build_write_advancing_lines	(	cb_tree	pos,
		cb_tree	lines
	)

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

 {
     cb_tree e;
     int opt;
 
     opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
     opt |= COB_WRITE_LINES;
     if (CB_LITERAL_P (lines)) {
         opt |= cb_get_int (lines);
         return cb_int_hex (opt);
     }
     e = cb_build_binary_op (cb_int (opt), '+', lines);
     return cb_build_cast_int (e);
 }

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	pos,
		cb_tree	mnemonic
	)

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

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

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

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

 {
     int opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER;
 
     return cb_int_hex (opt | COB_WRITE_PAGE);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void cb_check_data_incompat ( cb_tree x )

static

Definition at line 719 of file typeck.c.

References CB_BUILD_FUNCALL_1, CB_BUILD_FUNCALL_2, CB_BUILD_STRING0, CB_CATEGORY_NUMERIC, cb_emit, cb_error_node, CB_EXCEPTION_ENABLE, CB_FIELD_PTR, CB_REF_OR_FIELD_P, CB_TREE_CATEGORY, CB_USAGE_COMP_6, CB_USAGE_DISPLAY, CB_USAGE_PACKED, COB_EC_DATA_INCOMPATIBLE, cb_field::name, and cb_field::usage.

Referenced by cb_emit_arithmetic(), cb_emit_goto(), cb_emit_move(), and cb_emit_set_to().

 {
     struct cb_field     *f;
 
     if (!x || x == cb_error_node) {
         return;
     }
     if (!CB_REF_OR_FIELD_P (x) ||
         CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) {
         return;
     }
     f = CB_FIELD_PTR (x);
     if (cb_flag_correct_numeric && f->usage == CB_USAGE_DISPLAY) {
         cb_emit (CB_BUILD_FUNCALL_1 ("cob_correct_numeric", x));
     }
     if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE)) {
         if (f->usage == CB_USAGE_DISPLAY ||
             f->usage == CB_USAGE_PACKED ||
             f->usage == CB_USAGE_COMP_6) {
             cb_emit (CB_BUILD_FUNCALL_2 ("cob_check_numeric",
                     x,
                     CB_BUILD_STRING0 (f->name)));
         }
     }
 }

Here is the caller graph for this function:

void cb_check_field_debug ( cb_tree fld )

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

 {
     cb_tree     l;
     cb_tree     x;
     cb_tree     z;
     size_t      size;
     size_t      found;
     char        buff[COB_MINI_BUFF];
 
     /* Basic reference check */
     if (CB_WORD_COUNT (fld) > 0) {
         if (!CB_WORD_ITEMS (fld)) {
             return;
         }
         z = CB_VALUE(CB_WORD_ITEMS (fld));
         if (!CB_FIELD_P (z)) {
             return;
         }
         x = cb_ref (fld);
         if (x == cb_error_node) {
             return;
         }
     } else {
         return;
     }
 
     found = 0;
     /* Check if reference is being debugged */
     for (l = current_program->debug_list; l; l = CB_CHAIN (l)) {
         if (!CB_PURPOSE (l)) {
             continue;
         }
         if (x == CB_PURPOSE (l)) {
             if (CB_REFERENCE (fld)->flag_target ||
                 CB_REFERENCE (CB_VALUE (l))->flag_all_debug) {
                 found = 1;
             }
             break;
         }
     }
     if (!found) {
         return;
     }
 
     found = 0;
     /* Found it - check if it is already in the statement list */
     for (l = current_statement->debug_nodups; l; l = CB_CHAIN (l)) {
         if (CB_VALUE (l) == x) {
             found = 1;
             break;
         }
     }
     if (found) {
         return;
     }
 
     /* Set up debug info */
     strcpy (buff, CB_FIELD(x)->name);
     size = strlen (buff);
     for (l = CB_REFERENCE (fld)->chain; l; l = CB_REFERENCE (l)->chain) {
         z = cb_ref (l);
         if (z != cb_error_node) {
             size += strlen (CB_FIELD (z)->name);
             size += 4;
             if (size >= sizeof(buff)) {
                 break;
             }
             strcat (buff, " OF ");
             strcat (buff, CB_FIELD (z)->name);
         }
     }
     current_statement->debug_nodups =
         cb_list_add (current_statement->debug_nodups, x);
     current_statement->debug_check =
         cb_list_add (current_statement->debug_check,
                  cb_build_debug (cb_debug_name, buff, NULL));
     current_statement->debug_check =
         cb_list_add (current_statement->debug_check,
                  cb_build_debug (cb_debug_contents, NULL, fld));
     found = 0;
     CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs);
     l = CB_REFERENCE (fld)->subs;
     for (; l && found < 3; l = CB_CHAIN (l), ++found) {
         switch (found) {
         case 0:
             current_statement->debug_check =
                 cb_list_add (current_statement->debug_check,
                          cb_build_move (CB_VALUE (l),
                                 cb_debug_sub_1));
             break;
         case 1:
             current_statement->debug_check =
                 cb_list_add (current_statement->debug_check,
                          cb_build_move (CB_VALUE (l),
                                 cb_debug_sub_2));
             break;
         case 2:
             current_statement->debug_check =
                 cb_list_add (current_statement->debug_check,
                          cb_build_move (CB_VALUE (l),
                                 cb_debug_sub_3));
             break;
         default:
             break;
         }
     }
     CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs);
 
     for (; found < 3; ++found) {
         switch (found) {
         case 0:
             current_statement->debug_check =
                 cb_list_add (current_statement->debug_check,
                          CB_BUILD_FUNCALL_3 ("memset",
                         CB_BUILD_CAST_ADDRESS (cb_debug_sub_1),
                         cb_int (' '),
                         CB_BUILD_CAST_LENGTH (cb_debug_sub_1)));
             break;
         case 1:
             current_statement->debug_check =
                 cb_list_add (current_statement->debug_check,
                          CB_BUILD_FUNCALL_3 ("memset",
                         CB_BUILD_CAST_ADDRESS (cb_debug_sub_2),
                         cb_int (' '),
                         CB_BUILD_CAST_LENGTH (cb_debug_sub_2)));
             break;
         case 2:
             current_statement->debug_check =
                 cb_list_add (current_statement->debug_check,
                          CB_BUILD_FUNCALL_3 ("memset",
                         CB_BUILD_CAST_ADDRESS (cb_debug_sub_3),
                         cb_int (' '),
                         CB_BUILD_CAST_LENGTH (cb_debug_sub_3)));
             break;
         default:
             break;
         }
     }
 
     current_statement->debug_check =
         cb_list_add (current_statement->debug_check,
                  cb_build_debug_call (CB_FIELD(x)->debug_section));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_check_group_name ( cb_tree x )

static

Definition at line 592 of file typeck.c.

References _, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_P, cb_name(), cb_ref(), CB_REFERENCE, CB_REFERENCE_P, cb_field::children, NULL, and cb_field::offset.

Referenced by cb_emit_corresponding(), and cb_emit_move_corresponding().

 {
     cb_tree     y;
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
 
     if (CB_REFERENCE_P (x)) {
         y = cb_ref (x);
         if (y == cb_error_node) {
             return cb_error_node;
         }
         if (CB_FIELD_P (y) && CB_FIELD (y)->children != NULL &&
             CB_REFERENCE (x)->offset == NULL) {
             return x;
         }
     }
 
     cb_error_x (x, _("'%s' is not group name"), cb_name (x));
     return cb_error_node;
 }

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.

 {
     struct cb_field *f;
 
     if (!CB_REF_OR_FIELD_P (x)) {
         return 0;
     }
     f = CB_FIELD_PTR (x);
     if (f->usage == CB_USAGE_INDEX && !f->children) {
         return 1;
     }
     return 0;
 }

static cb_tree cb_check_integer_value ( cb_tree x )

static

Definition at line 666 of file typeck.c.

References _, CB_CATEGORY_NUMERIC, cb_error_node, cb_error_x(), CB_FIELD, CB_LITERAL, cb_name(), cb_ref(), CB_TAG_BINARY_OP, CB_TAG_CONST, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_CATEGORY, CB_TREE_TAG, cb_zero, cb_field::pic, cb_literal::scale, cb_picture::scale, and cb_literal::sign.

Referenced by cb_build_identifier(), and cb_build_perform_times().

 {
     struct cb_literal   *l;
     struct cb_field     *f;
     cb_tree         y;
 
     if (x == cb_error_node) {
         return cb_error_node;
     }
 
     if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) {
         goto invalid;
     }
 
     switch (CB_TREE_TAG (x)) {
     case CB_TAG_CONST:
         if (x != cb_zero) {
             goto invalid;
         }
         return x;
     case CB_TAG_LITERAL:
         l = CB_LITERAL (x);
         if (l->sign < 0 || l->scale > 0) {
             goto invliteral;
         }
         return x;
     case CB_TAG_REFERENCE:
         y = cb_ref (x);
         if (y == cb_error_node) {
             return cb_error_node;
         }
         f = CB_FIELD (y);
         if (f->pic->scale > 0) {
             goto invalid;
         }
         return x;
     case CB_TAG_BINARY_OP:
         /* TODO: need to check */
         return x;
     case CB_TAG_INTRINSIC:
         /* TODO: need to check */
         return x;
     default:
 invalid:
         cb_error_x (x, _("'%s' is not an integer value"), cb_name (x));
         return cb_error_node;
     }
 invliteral:
     cb_error_x (x, _("A positive numeric integer is required here"));
     return cb_error_node;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void cb_check_lit_subs	(	struct cb_reference *	r,
		const int	numsubs,
		const int	numindex
	)

static

Definition at line 746 of file typeck.c.

References CB_BUILD_CHAIN, cb_build_numsize_literal(), CB_CHAIN, cb_error_node, CB_LITERAL, CB_LITERAL_P, CB_VALUE, current_program, cb_literal::data, cb_program::decimal_point, cb_literal::scale, cb_literal::sign, cb_literal::size, and cb_reference::subs.

Referenced by cb_build_identifier().

 {
     cb_tree         l;
     cb_tree         v;
     struct cb_literal   *lt;
     int         size;
 
     /* Check for DPC and non-standard separator usage */
     if (!cb_relaxed_syntax_check ||
         current_program->decimal_point != ',') {
         return;
     }
     if (numsubs > numindex) {
         return;
     }
 
     for (l = r->subs; l; l = CB_CHAIN (l)) {
         v = CB_VALUE (l);
         if (v == cb_error_node) {
             continue;
         }
         if (!CB_LITERAL_P (v)) {
             continue;
         }
         lt = CB_LITERAL (v);
         if (!lt->scale) {
             continue;
         }
         if (lt->scale == (int)lt->size) {
             lt->scale = 0;
             continue;
         }
         size = lt->size - lt->scale;
         v = cb_build_numsize_literal (&lt->data[size],
                           (size_t)lt->scale, lt->sign);
         CB_VALUE (l) = v;
         v = cb_build_numsize_literal (lt->data, (size_t)size, 0);
         CB_CHAIN (l) = CB_BUILD_CHAIN (v, CB_CHAIN (l));
     }
     return;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_check_needs_break ( cb_tree stmt )

static

Definition at line 523 of file typeck.c.

References cb_build_direct(), CB_CHAIN, CB_GOTO_P, cb_list_add(), CB_STATEMENT, CB_STATEMENT_P, and CB_VALUE.

Referenced by cb_build_if_check_break(), cb_emit_search(), and cb_emit_search_all().

 {
     cb_tree     l;
 
     /* Check if last statement is GO TO */
     for (l = stmt; l; l = CB_CHAIN (l)) {
         if (!CB_CHAIN(l)) {
             break;
         }
     }
     if (l && CB_VALUE (l) && CB_STATEMENT_P (CB_VALUE (l))) {
         l = CB_STATEMENT(CB_VALUE(l))->body;
         if (l && CB_VALUE (l) && !CB_GOTO_P (CB_VALUE(l))) {
             /* Append a break */
             l = cb_build_direct ("break;", 0);
             return cb_list_add (stmt, l);
         }
     }
     return stmt;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_check_numeric_edited_name ( cb_tree x )

static

Definition at line 633 of file typeck.c.

References _, CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, cb_error_node, cb_error_x(), CB_FIELD_P, cb_name(), cb_ref(), CB_REFERENCE_P, and CB_TREE_CATEGORY.

Referenced by cb_emit_arithmetic(), and cb_emit_divide().

 {
     if (x == cb_error_node) {
         return cb_error_node;
     }
 
     if (CB_REFERENCE_P (x) &&
         CB_FIELD_P (cb_ref (x)) &&
         (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC ||
          CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC_EDITED)) {
         return x;
     }
 
     cb_error_x (x, _("'%s' is not numeric or numeric-edited name"), cb_name (x));
     return cb_error_node;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_check_numeric_name ( cb_tree x )

static

Definition at line 616 of file typeck.c.

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

Referenced by cb_emit_arithmetic().

 {
     if (x == cb_error_node) {
         return cb_error_node;
     }
 
     if (CB_REFERENCE_P (x) &&
         CB_FIELD_P (cb_ref (x)) &&
         CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) {
         return x;
     }
 
     cb_error_x (x, _("'%s' is not a numeric name"), cb_name (x));
     return cb_error_node;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

cb_tree cb_check_numeric_value ( cb_tree x )

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

static size_t cb_check_overlapping	(	cb_tree	src,
		cb_tree	dst,
		struct cb_field *	src_f,
		struct cb_field *	dst_f
	)

static

Definition at line 6078 of file typeck.c.

References _, cb_field_founder(), cb_field_size(), cb_field_variable_size(), cb_get_int(), CB_LITERAL_P, CB_REFERENCE, cb_warning_x(), cb_field::children, f1, cb_field::flag_occurs, cb_field::mem_offset, cb_field::offset, cb_reference::offset, cb_field::redefines, cb_field::sister, cb_tree_common::source_line, and suppress_warn.

Referenced by validate_move().

 {
     struct cb_field *f1;
     struct cb_field *ff1;
     struct cb_field *ff2;
     struct cb_reference *r;
     cb_tree     loc;
     int     src_size;
     int     dst_size;
     int     src_off;
     int     dst_off;
 
     /* Check basic overlapping */
     for (f1 = src_f->children; f1; f1 = f1->sister) {
         if (f1 == dst_f) {
             goto overlapret;
         }
     }
     for (f1 = dst_f->children; f1; f1 = f1->sister) {
         if (f1 == src_f) {
             goto overlapret;
         }
     }
     ff1 = cb_field_founder (src_f);
     ff2 = cb_field_founder (dst_f);
     if (ff1->redefines) {
         ff1 = ff1->redefines;
     }
     if (ff2->redefines) {
         ff2 = ff2->redefines;
     }
     if (ff1 != ff2) {
         return 0;
     }
 
     src_size = cb_field_size (src);
     dst_size = cb_field_size (dst);
 
     if (src_size <= 0 || dst_size <= 0 ||
         cb_field_variable_size (src_f) ||
         cb_field_variable_size (dst_f)) {
         return 1; /* overlapping possible, would need more checks */
     }
     /* Check literal occurs? */
     if ((src_f->flag_occurs && !src_f->mem_offset) ||
         (dst_f->flag_occurs && !dst_f->mem_offset)) {
         return 1; /* overlapping possible, would need more checks */
     }
 
     /* Same field - Check offsets */
     src_off = src_f->offset;
     dst_off = dst_f->offset;
 
     /* Adjusting offsets by occurs and reference modification */
     src_off += src_f->mem_offset ;
     r = CB_REFERENCE (src);
     if (r->offset) {
         if (CB_LITERAL_P (r->offset)) {
             src_off += cb_get_int (r->offset) - 1;
         } else {
             goto overlapret;
         }
     }
     dst_off += dst_f->mem_offset;
     r = CB_REFERENCE (dst);
     if (r->offset) {
         if (CB_LITERAL_P (r->offset)) {
             dst_off += cb_get_int (r->offset) - 1;
         } else {
             goto overlapret;
         }
     }
     if (src_off >= dst_off && src_off < (dst_off + dst_size)) {
         goto overlapret;
     }
     if (src_off < dst_off && (src_off + src_size) > dst_off) {
         goto overlapret;
     }
     return 0;
 overlapret:
     loc = src->source_line ? src : dst;
     if (cb_warn_overlap && !suppress_warn) {
         cb_warning_x (loc, _("Overlapping MOVE may produce unpredictable results"));
     }
     return 1;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int cb_chk_alpha_cond ( cb_tree x )

static

Definition at line 3712 of file typeck.c.

References cb_program::alphabet_name_list, CB_CATEGORY_ALPHABETIC, CB_CATEGORY_ALPHANUMERIC, CB_FIELD_PTR, cb_field_size(), cb_field_variable_size(), CB_LITERAL_P, CB_REF_OR_FIELD_P, CB_TREE_CATEGORY, and current_program.

Referenced by cb_build_cond().

 {
     if (current_program->alphabet_name_list) {
         return 0;
     }
     if (CB_LITERAL_P (x)) {
         return 1;
     }
     if (!CB_REF_OR_FIELD_P (x)) {
         return 0;
     }
     if (CB_TREE_CATEGORY (x) != CB_CATEGORY_ALPHANUMERIC &&
         CB_TREE_CATEGORY (x) != CB_CATEGORY_ALPHABETIC) {
         return 0;
     }
     if (cb_field_variable_size (CB_FIELD_PTR (x))) {
         return 0;
     }
     if (cb_field_size (x) < 0) {
         return 0;
     }
     return 1;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int cb_chk_num_cond	(	cb_tree	x,
		cb_tree	y
	)

static

Definition at line 3668 of file typeck.c.

References CB_CATEGORY_NUMERIC, CB_CLASS_NUMERIC, CB_FIELD_PTR, CB_REF_OR_FIELD_P, CB_TREE_CATEGORY, CB_TREE_CLASS, CB_USAGE_DISPLAY, cb_picture::have_sign, cb_field::pic, cb_picture::scale, cb_field::size, and cb_field::usage.

Referenced by cb_build_cond().

 {
     struct cb_field     *fx;
     struct cb_field     *fy;
 
     if (!CB_REF_OR_FIELD_P (x)) {
         return 0;
     }
     if (!CB_REF_OR_FIELD_P (y)) {
         return 0;
     }
     if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) {
         return 0;
     }
     if (CB_TREE_CATEGORY (y) != CB_CATEGORY_NUMERIC) {
         return 0;
     }
     if (CB_TREE_CLASS (x) != CB_CLASS_NUMERIC) {
         return 0;
     }
     if (CB_TREE_CLASS (y) != CB_CLASS_NUMERIC) {
         return 0;
     }
     fx = CB_FIELD_PTR (x);
     fy = CB_FIELD_PTR (y);
     if (fx->usage != CB_USAGE_DISPLAY) {
         return 0;
     }
     if (fy->usage != CB_USAGE_DISPLAY) {
         return 0;
     }
     if (fx->pic->have_sign || fy->pic->have_sign) {
         return 0;
     }
     if (fx->size != fy->size) {
         return 0;
     }
     if (fx->pic->scale != fy->pic->scale) {
         return 0;
     }
     return 1;
 }

Here is the caller graph for this function:

cb_tree cb_define_switch_name	(	cb_tree	name,
		cb_tree	sname,
		const int	flag
	)

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

 {
     cb_tree     switch_id;
     cb_tree     value;
 
     if (!name || name == cb_error_node) {
         return NULL;
     }
     if (!sname || sname == cb_error_node ||
         CB_SYSTEM_NAME (sname)->category != CB_SWITCH_NAME) {
         cb_error_x (name, _("ON/OFF usage requires a SWITCH name"));
         return NULL;
     }
     switch_id = cb_int (CB_SYSTEM_NAME (sname)->token);
     value = CB_BUILD_FUNCALL_1 ("cob_get_switch", switch_id);
     if (flag == 0) {
         value = CB_BUILD_NEGATION (value);
     }
     cb_build_constant (name, value);
     return value;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept	(	cb_tree	var,
		cb_tree	pos,
		struct cb_attr_struct *	attr_ptr
	)

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

 {
     cb_tree     line;
     cb_tree     column;
     cb_tree     fgc;
     cb_tree     bgc;
     cb_tree     scroll;
     cb_tree     timeout;
     cb_tree     prompt;
     cb_tree     size_is;    /* WITH SIZE IS */
     int     dispattrs;
 
     if (cb_validate_one (var)) {
         return;
     }
 
     if (attr_ptr) {
         fgc = attr_ptr->fgc;
         bgc = attr_ptr->bgc;
         scroll = attr_ptr->scroll;
         timeout = attr_ptr->timeout;
         prompt = attr_ptr->prompt;
         size_is = attr_ptr->size_is;
         dispattrs = attr_ptr->dispattrs;
         if (cb_validate_one (pos)) {
             return;
         }
         if (cb_validate_one (fgc)) {
             return;
         }
         if (cb_validate_one (bgc)) {
             return;
         }
         if (cb_validate_one (scroll)) {
             return;
         }
         if (cb_validate_one (timeout)) {
             return;
         }
         if (cb_validate_one (prompt)) {
             return;
         }
         if (cb_validate_one (size_is)) {
             return;
         }
     } else {
         fgc = NULL;
         bgc = NULL;
         scroll = NULL;
         timeout = NULL;
         prompt = NULL;
         size_is = NULL;
         dispattrs = 0;
     }
 
     if (prompt) {
         /* PROMPT character - 1 character identifier or literal */
         if (CB_LITERAL_P (prompt)) {
             if (CB_LITERAL (prompt)->size != 1) {
                 cb_error_x (prompt, _("Invalid PROMPT literal"));
                 return;
             }
         } else {
             if (CB_FIELD_PTR (prompt)->size != 1) {
                 cb_error_x (prompt, _("Invalid PROMPT identifier"));
                 return;
             }
         }
     }
 
 #if 0   /* RXWRXW - Screen */
     if ((CB_REF_OR_FIELD_P (var)) &&
          CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) {
         current_program->flag_screen = 1;
     }
 #endif
 
     if (current_program->flag_screen) {
         /* Bump ref count to force CRT STATUS field generation */
         if (current_program->crt_status) {
             CB_FIELD_PTR (current_program->crt_status)->count++;
         }
         if ((CB_REF_OR_FIELD_P (var)) &&
              CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) {
             output_screen_from (CB_FIELD (cb_ref (var)), 0);
             gen_screen_ptr = 1;
             if (pos) {
                 if (CB_LIST_P (pos)) {
                     line = CB_PAIR_X (pos);
                     column = CB_PAIR_Y (pos);
                     cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
                         var, line, column, timeout));
                 } else if (valid_screen_pos (pos)) {
                     cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
                         var, pos, NULL, timeout));
                 }
             } else {
                 cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_accept",
                     var, NULL, NULL, timeout));
             }
             gen_screen_ptr = 0;
             output_screen_to (CB_FIELD (cb_ref (var)), 0);
         } else {
             if (var == cb_null) {
                 var = NULL;
             }
             if (pos || fgc || bgc || scroll || dispattrs) {
                 cb_gen_field_accept (var, pos, fgc, bgc, scroll,
                              timeout, prompt, size_is, dispattrs);
             } else {
                 cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept",
                     var, NULL, NULL, fgc, bgc,
                     scroll, timeout, prompt,
                     size_is, cb_int (dispattrs)));
             }
         }
     } else if (pos || fgc || bgc || scroll || dispattrs) {
         /* Bump ref count to force CRT STATUS field generation */
         if (current_program->crt_status) {
             CB_FIELD_PTR (current_program->crt_status)->count++;
         }
         if (var == cb_null) {
             var = NULL;
         }
         cb_gen_field_accept (var, pos, fgc, bgc, scroll,
                      timeout, prompt, size_is, dispattrs);
     } else {
         if (var == cb_null) {
             var = NULL;
         }
         cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_arg_number ( cb_tree var )

Definition at line 4596 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_arg_value ( cb_tree var )

Definition at line 4605 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_command_line ( cb_tree var )

Definition at line 4566 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_date ( cb_tree var )

Definition at line 4512 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_date_yyyymmdd ( cb_tree var )

Definition at line 4521 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_day ( cb_tree var )

Definition at line 4530 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

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

Definition at line 4548 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_day_yyyyddd ( cb_tree var )

Definition at line 4539 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_environment ( cb_tree var )

Definition at line 4587 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_escape_key ( cb_tree var )

Definition at line 4485 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

 {
     if (cb_validate_one (var)) {
         return;
     }
     cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_escape_key", var));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_exception_status ( cb_tree var )

Definition at line 4494 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

 {
     if (cb_validate_one (var)) {
         return;
     }
     cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_exception_status", var));
 }

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	var,
		const int	l_or_c
	)

Definition at line 4476 of file typeck.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_mnemonic	(	cb_tree	var,
		cb_tree	mnemonic
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_name	(	cb_tree	var,
		cb_tree	name
	)

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

 {
     cb_tree     sys;
 
     if (cb_validate_one (var)) {
         return;
     }
 
     /* Allow direct reference to a device name */
     sys = lookup_system_name (CB_NAME (name));
     if (sys) {
         switch (CB_SYSTEM_NAME (sys)->token) {
         case CB_DEVICE_CONSOLE:
         case CB_DEVICE_SYSIN:
             if (!cb_relaxed_syntax_check) {
                 cb_warning_x (name, _("'%s' is not defined in SPECIAL-NAMES"), CB_NAME (name));
             }
             cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var));
             return;
         default:
             cb_error_x (name, _("Invalid input device '%s'"),
                     cb_name (name));
             return;
         }
     }
 
     cb_error_x (name, _("'%s' is not defined in SPECIAL-NAMES"),
             CB_NAME (name));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_time ( cb_tree var )

Definition at line 4557 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_accept_user_name ( cb_tree var )

Definition at line 4503 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

 {
     if (cb_validate_one (var)) {
         return;
     }
     cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_user_name", var));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     cb_tree     x;
     char        buff[32];
 
     if (cb_validate_one (target1)) {
         return;
     }
     if (cb_validate_one (target2)) {
         return;
     }
     if (cb_validate_one (size)) {
         return;
     }
     if (cb_validate_one (initialize)) {
         return;
     }
     if (target1) {
         if (!(CB_REFERENCE_P(target1) &&
               CB_FIELD_PTR (target1)->flag_item_based)) {
             cb_error_x (CB_TREE(current_statement),
                 _("Target of ALLOCATE is not a BASED item"));
             return;
         }
     }
     if (target2) {
         if (!(CB_REFERENCE_P(target2) &&
               CB_TREE_CLASS (target2) == CB_CLASS_POINTER)) {
             cb_error_x (CB_TREE(current_statement),
                 _("Target of RETURNING is not a data pointer"));
             return;
         }
     }
     if (size) {
         if (CB_TREE_CLASS (size) != CB_CLASS_NUMERIC) {
             cb_error_x (CB_TREE(current_statement),
                 _("The CHARACTERS field of ALLOCATE must be numeric"));
             return;
         }
     }
     if (target1) {
         sprintf (buff, "%d", CB_FIELD_PTR (target1)->memory_size);
         x = cb_build_numeric_literal (0, buff, 0);
         cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate",
              CB_BUILD_CAST_ADDR_OF_ADDR (target1),
              target2, x, NULL));
     } else {
         if (initialize && !cb_category_is_alpha (initialize)) {
             cb_error_x (CB_TREE(current_statement),
                 _("INITIALIZED TO item is not alphanumeric"));
         }
         cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate",
              NULL, target2, size, initialize));
     }
     if (initialize && target1) {
         current_statement->handler2 =
             cb_build_initialize (target1, cb_true, NULL, 1, 0, 0);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_alter	(	cb_tree	source,
		cb_tree	target
	)

Definition at line 4733 of file typeck.c.

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

Referenced by yyparse().

 {
     if (source == cb_error_node) {
         return;
     }
     if (target == cb_error_node) {
         return;
     }
     CB_REFERENCE(source)->flag_alter_code = 1;
     cb_emit (cb_build_alter (source, target));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_arg_number ( cb_tree value )

Definition at line 5124 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     cb_tree     l;
     cb_tree     x;
 
     x = cb_check_numeric_value (val);
 
     if (op) {
         cb_list_map (cb_check_numeric_name, vars);
     } else {
         cb_list_map (cb_check_numeric_edited_name, vars);
     }
 
     if (cb_validate_one (x)) {
         return;
     }
     if (cb_validate_list (vars)) {
         return;
     }
 
     if (!CB_BINARY_OP_P (x)) {
         if (op == '+' || op == '-' || op == '*' || op == '/') {
             cb_check_data_incompat (x);
             for (l = vars; l; l = CB_CHAIN (l)) {
                 cb_check_data_incompat (CB_VALUE (l));
                 switch (op) {
                 case '+':
                     CB_VALUE (l) = cb_build_add (CB_VALUE (l), x, CB_PURPOSE (l));
                     break;
                 case '-':
                     CB_VALUE (l) = cb_build_sub (CB_VALUE (l), x, CB_PURPOSE (l));
                     break;
                 case '*':
                     CB_VALUE (l) = cb_build_mul (CB_VALUE (l), x, CB_PURPOSE (l));
                     break;
                 case '/':
                     CB_VALUE (l) = cb_build_div (CB_VALUE (l), x, CB_PURPOSE (l));
                     break;
                 }
             }
             cb_emit_list (vars);
             return;
         }
     }
     if (x == cb_error_node) {
         return;
     }
 
     cb_emit_list (build_decimal_assign (vars, op, x));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_call	(	cb_tree	prog,
		cb_tree	par_using,
		cb_tree	returning,
		cb_tree	on_exception,
		cb_tree	not_on_exception,
		cb_tree	convention
	)

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

 {
     cb_tree             l;
     cb_tree             x;
     struct cb_field         *f;
     const struct system_table   *psyst;
     const char          *p;
     const char          *entry;
     cob_s64_t           val;
     cob_s64_t           valmin;
     cob_s64_t           valmax;
     cob_u32_t           is_sys_call;
     cob_u32_t           is_sys_idx;
     int             error_ind;
     int             call_conv;
     int             numargs;
 
     if (CB_INTRINSIC_P (prog)) {
         if (CB_INTRINSIC(prog)->intr_tab->category != CB_CATEGORY_ALPHANUMERIC) {
             cb_error_x (CB_TREE (current_statement),
                     _("Only alphanumeric FUNCTION types are allowed here"));
             return;
         }
     }
     if (returning && returning != cb_null) {
         if (CB_TREE_CLASS(returning) != CB_CLASS_NUMERIC &&
             CB_TREE_CLASS(returning) != CB_CLASS_POINTER) {
             cb_error_x (CB_TREE (current_statement),
                     _("Invalid RETURNING field"));
             return;
         }
     }
 
     error_ind = 0;
     numargs = 0;
 
     if (convention) {
         if (CB_INTEGER_P (convention)) {
             call_conv = CB_INTEGER (convention)->val;
         } else {
             call_conv = cb_get_int (convention);
         }
     } else {
         call_conv = 0;
     }
 #ifndef _WIN32
     if (call_conv & CB_CONV_STDCALL) {
         call_conv &= ~CB_CONV_STDCALL;
         if (warningopt) {
             cb_warning (_("STDCALL not available on this platform"));
         }
     }
 #elif   defined(_WIN64)
     if (call_conv & CB_CONV_STDCALL) {
         if (warningopt) {
             cb_warning (_("STDCALL used on 64-bit Windows platform"));
         }
     }
 #endif
     if ((call_conv & CB_CONV_STATIC_LINK) && !CB_LITERAL_P (prog)) {
         cb_error_x (CB_TREE (current_statement),
                 _("STATIC CALL convention requires a literal program name"));
         error_ind = 1;
     }
 
     for (l = par_using; l; l = CB_CHAIN (l), numargs++) {
         x = CB_VALUE (l);
         if (x == cb_error_node) {
             error_ind = 1;
             continue;
         }
         if (CB_NUMERIC_LITERAL_P (x)) {
             if (CB_PURPOSE_INT (l) != CB_CALL_BY_VALUE) {
                 continue;
             }
             if (CB_SIZES_INT_UNSIGNED(l) &&
                 CB_LITERAL (x)->sign < 0) {
                 cb_error_x (x, _("Numeric literal is negative"));
                 error_ind = 1;
                 continue;
             }
             val = 0;
             valmin = 0;
             valmax = 0;
             switch (CB_SIZES_INT (l)) {
             case CB_SIZE_1:
                 val = cb_get_long_long (x);
                 if (CB_SIZES_INT_UNSIGNED(l)) {
                     valmin = 0;
                     valmax = UCHAR_MAX;
                 } else {
                     valmin = CHAR_MIN;
                     valmax = CHAR_MAX;
                 }
                 break;
             case CB_SIZE_2:
                 val = cb_get_long_long (x);
                 if (CB_SIZES_INT_UNSIGNED(l)) {
                     valmin = 0;
                     valmax = USHRT_MAX;
                 } else {
                     valmin = SHRT_MIN;
                     valmax = SHRT_MAX;
                 }
                 break;
             case CB_SIZE_4:
                 val = cb_get_long_long (x);
                 if (CB_SIZES_INT_UNSIGNED(l)) {
                     valmin = 0;
                     valmax = UINT_MAX;
                 } else {
                     valmin = INT_MIN;
                     valmax = INT_MAX;
                 }
                 break;
             case CB_SIZE_8:
             case CB_SIZE_AUTO:
                 if (CB_SIZES_INT_UNSIGNED(l)) {
                     if (CB_LITERAL (x)->size < 20) {
                         break;
                     }
                     if (CB_LITERAL (x)->size > 20) {
                         valmin = 1;
                         break;
                     }
                     if (memcmp (CB_LITERAL (x)->data,
                             "18446744073709551615",
                             (size_t)20) > 0) {
                         valmin = 1;
                         break;
                     }
                 } else {
                     if (CB_LITERAL (x)->size < 19) {
                         break;
                     }
                     if (CB_LITERAL (x)->size > 19) {
                         valmin = 1;
                         break;
                     }
                     if (memcmp (CB_LITERAL (x)->data,
                             "9223372036854775807",
                             (size_t)19) > 0) {
                         valmin = 1;
                         break;
                     }
                 }
                 break;
             default:
                 break;
             }
             if (!valmin && !valmax) {
                 continue;
             }
             if (val < valmin || val > valmax) {
                 cb_error_x (x, _("Numeric literal exceeds size limits"));
                 error_ind = 1;
             }
             continue;
         }
         if (CB_CONST_P (x) && x != cb_null) {
             cb_error_x (x, _("Figurative constant invalid here"));
             error_ind = 1;
             continue;
         }
         if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) ||
             CB_FIELD_P (x)) {
             f = CB_FIELD_PTR (x);
             if (f->level == 88) {
                 cb_error_x (x, _("'%s' is not a valid data name"), CB_NAME (x));
                 error_ind = 1;
                 continue;
             }
             if (f->flag_any_length &&
                 CB_PURPOSE_INT (l) != CB_CALL_BY_REFERENCE) {
                 cb_error_x (x, _("'%s' ANY LENGTH item not passed BY REFERENCE"), CB_NAME (x));
                 error_ind = 1;
                 continue;
             }
             if (cb_warn_call_params &&
                 CB_PURPOSE_INT (l) == CB_CALL_BY_REFERENCE) {
                 if (f->level != 01 && f->level != 77) {
                     cb_warning_x (x, _("'%s' is not a 01 or 77 level item"), CB_NAME (x));
                 }
             }
         }
     }
 
     is_sys_call = 0;
     if (CB_LITERAL_P(prog)) {
         entry = NULL;
         p = (const char *)CB_LITERAL(prog)->data;
         for (; *p; ++p) {
             if (*p == '/' || *p == '\\') {
                 entry = p + 1;
             }
         }
         if (!entry) {
             entry = (const char *)CB_LITERAL(prog)->data;
         }
         is_sys_idx = 1;
         for (psyst = system_tab; psyst->syst_name; psyst++, is_sys_idx++) {
             if (!strcmp(entry, (const char *)psyst->syst_name)) {
                 if (psyst->syst_params > cb_list_length (par_using)) {
                     cb_error_x (CB_TREE (current_statement),
                             _("Wrong number of CALL parameters for '%s'"),
                             (char *)psyst->syst_name);
                     return;
                 }
                 is_sys_call = is_sys_idx;
                 break;
             }
         }
     }
 
     if (error_ind) {
         return;
     }
     if (numargs > current_program->max_call_param) {
         current_program->max_call_param = numargs;
     }
     cb_emit (cb_build_call (prog, par_using, on_exception, not_on_exception,
          returning, is_sys_call, call_conv));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_cancel ( cb_tree prog )

Definition at line 4977 of file typeck.c.

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

Referenced by yyparse().

 {
     if (cb_validate_one (prog)) {
         return;
     }
     cb_emit (cb_build_cancel (prog));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_close	(	cb_tree	file,
		cb_tree	opt
	)

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

 {
     struct cb_file  *f;
 
     if (file == cb_error_node) {
         return;
     }
     file = cb_ref (file);
     if (file == cb_error_node) {
         return;
     }
     current_statement->file = file;
     f = CB_FILE (file);
 
     if (f->organization == COB_ORG_SORT) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "CLOSE", "SORT");
     }
 
     cb_emit (CB_BUILD_FUNCALL_4 ("cob_close", file,
                      f->file_status, opt, cb_int0));
 
     /* Check for file debugging */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         CB_FILE(file)->flag_fl_debug) {
         cb_emit (cb_build_debug (cb_debug_name, f->name, NULL));
         cb_emit (cb_build_move (cb_space, cb_debug_contents));
         cb_emit (cb_build_debug_call (f->debug_section));
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_command_line ( cb_tree value )

Definition at line 5133 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

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

 {
     cb_emit (CB_BUILD_FUNCALL_0 ("cob_commit"));
 }

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

 {
     cb_emit (cb_build_continue ());
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 4124 of file typeck.c.

References _, cb_check_group_name(), cb_validate_one(), cb_warning_x(), and emit_corresponding().

 {
     x1 = cb_check_group_name (x1);
     x2 = cb_check_group_name (x2);
 
     if (cb_validate_one (x1)) {
         return;
     }
     if (cb_validate_one (x2)) {
         return;
     }
 
     if (!emit_corresponding (func, x1, x2, opt)) {
         if (cb_warn_corresponding) {
             cb_warning_x (x2, _("No CORRESPONDING items found"));
         }
     }
 }

Here is the call graph for this function:

void cb_emit_delete ( cb_tree file )

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

 {
     struct cb_file  *f;
 
     if (file == cb_error_node) {
         return;
     }
     file = cb_ref (file);
     if (file == cb_error_node) {
         return;
     }
     current_statement->file = file;
     f = CB_FILE (file);
 
     if (f->organization == COB_ORG_SORT) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "DELETE", "SORT");
         return;
     } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "DELETE", "LINE SEQUENTIAL");
         return;
     }
 
     /* Check for file debugging */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         f->flag_fl_debug) {
         /* Gen callback after delete but before exception test */
         current_statement->flag_callback = 1;
     }
 
     cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete", file,
                      f->file_status));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_delete_file ( cb_tree file )

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

 {
     if (file == cb_error_node) {
         return;
     }
     file = cb_ref (file);
     if (file == cb_error_node) {
         return;
     }
     if (CB_FILE (file)->organization == COB_ORG_SORT) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "DELETE FILE", "SORT");
         return;
     }
 
     /* Check for file debugging */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         CB_FILE(file)->flag_fl_debug) {
         /* Gen callback after delete but before exception test */
         current_statement->flag_callback = 1;
     }
 
     cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete_file", file,
                      CB_FILE(file)->file_status));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_display	(	cb_tree	values,
		cb_tree	upon,
		cb_tree	no_adv,
		cb_tree	pos,
		struct cb_attr_struct *	attr_ptr
	)

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

 {
     cb_tree     l;
     cb_tree     x;
     cb_tree     p;
     cb_tree     fgc;
     cb_tree     bgc;
     cb_tree     scroll;
     cb_tree     size_is;    /* WITH SIZE IS */
     int     dispattrs;
 
     if (cb_validate_list (values)) {
         return;
     }
 
     initialize_attrs (attr_ptr, &fgc, &bgc, &scroll, &size_is, &dispattrs);
     if (validate_attrs (pos, fgc, bgc, scroll, size_is)) {
         return;
     }
 
     for (l = values; l; l = CB_CHAIN (l)) {
         x = CB_VALUE (l);
         if (x == cb_error_node) {
             return;
         }
 
         switch (CB_TREE_TAG (x)) {
         case CB_TAG_LITERAL:
         case CB_TAG_INTRINSIC:
         case CB_TAG_CONST:
         case CB_TAG_STRING:
         case CB_TAG_INTEGER:
             break;
         case CB_TAG_REFERENCE:
             if (!CB_FIELD_P(CB_REFERENCE(x)->value)) {
                 cb_error_x (x, _("'%s' is an invalid type for DISPLAY operand"), cb_name (x));
                 return;
             }
             break;
         default:
             cb_error_x (x, _("Invalid type for DISPLAY operand"));
             return;
         }
     }
     if (upon == cb_error_node
         || !values /* <- silence warnings */) {
         return;
     }
 
 
     x = CB_VALUE (values);
     if ((CB_REF_OR_FIELD_P (x)) &&
          CB_FIELD (cb_ref (x))->storage == CB_STORAGE_SCREEN) {
         output_screen_from (CB_FIELD (cb_ref (x)), 0);
         gen_screen_ptr = 1;
             emit_screen_display (x, pos);
         gen_screen_ptr = 0;
     } else if (pos || fgc || bgc || scroll || size_is || dispattrs || upon == cb_null) {
         for (l = values; l; l = CB_CHAIN (l)) {
             x = CB_VALUE (l);
             /* low-values position cursor, size does not matter */
             if (x == cb_low) {
               dispattrs |= COB_SCREEN_NO_DISP;
             }
             /* no WITH SIZE then SPACE clears to end of screen */
             if (!(size_is)) {
               if (x == cb_space) {
                   dispattrs |= COB_SCREEN_ERASE_EOS;
                   dispattrs |= COB_SCREEN_NO_DISP;
               } else if (x == cb_low) {
                   dispattrs |= COB_SCREEN_NO_DISP;
               } else if (CB_LITERAL_P (x) && CB_LITERAL (x)->all &&
                     CB_LITERAL (x)->size == 1) {
                   if (CB_LITERAL (x)->data[0] == 1) {
                       dispattrs |= COB_SCREEN_ERASE_EOL;
                       dispattrs |= COB_SCREEN_NO_DISP;
                   } else if (CB_LITERAL (x)->data[0] == 2) {
                       cb_emit (CB_BUILD_FUNCALL_0 ("cob_sys_clear_screen"));
                       return;
                   } else if (CB_LITERAL (x)->data[0] == 7) {
                       dispattrs |= COB_SCREEN_BELL;
                       dispattrs |= COB_SCREEN_NO_DISP;
                   }
               }
             }
             emit_field_display (x, pos, fgc, bgc, scroll, size_is, dispattrs);
         }
     } else {
         /* DISPLAY x ... [UPON device-name] */
         p = CB_BUILD_FUNCALL_3 ("cob_display", upon, no_adv, values);
         CB_FUNCALL(p)->varcnt = cb_list_length (values);
         CB_FUNCALL(p)->nolitcast = 1;
         cb_emit (p);
         for (l = values; l; l = CB_CHAIN (l)) {
             x = CB_VALUE (l);
             if (CB_FIELD_P (x)) {
                 CB_FIELD (cb_ref (x))->count++;
             }
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_display_omitted	(	cb_tree	pos,
		struct cb_attr_struct *	attr_ptr
	)

Definition at line 5217 of file typeck.c.

References initialize_attrs(), and validate_attrs().

Referenced by yyparse().

 {
     cb_tree     fgc;
     cb_tree     bgc;
     cb_tree     scroll;
     cb_tree     size_is;    /* WITH SIZE IS */
     int     dispattrs;
 
     initialize_attrs (attr_ptr, &fgc, &bgc, &scroll, &size_is, &dispattrs);
     if (validate_attrs (pos, fgc, bgc, scroll, size_is)) {
         return;
     }
 
     /* TODO: Implement */
     /* Should we create a distinct omitted_display function in screenio.c? */
     /* emit_field_display (NULL, pos, fgc, bgc, scroll, size_is, dispattrs); */
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     if (cb_validate_one (dividend)) {
         return;
     }
     if (cb_validate_one (divisor)) {
         return;
     }
     CB_VALUE (quotient) = cb_check_numeric_edited_name (CB_VALUE (quotient));
     CB_VALUE (remainder) = cb_check_numeric_edited_name (CB_VALUE (remainder));
 
     if (cb_validate_one (CB_VALUE (quotient))) {
         return;
     }
     if (cb_validate_one (CB_VALUE (remainder))) {
         return;
     }
 
     cb_emit (CB_BUILD_FUNCALL_4 ("cob_div_quotient", dividend, divisor,
                      CB_VALUE (quotient),
                      build_store_option (CB_VALUE (quotient),
                              CB_PURPOSE (quotient))));
     cb_emit (CB_BUILD_FUNCALL_2 ("cob_div_remainder", CB_VALUE (remainder),
                      build_store_option (CB_VALUE (remainder),
                              cb_int0)));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_env_name ( cb_tree value )

Definition at line 5106 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_env_value ( cb_tree value )

Definition at line 5115 of file typeck.c.

References CB_BUILD_FUNCALL_1, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_evaluate	(	cb_tree	subject_list,
		cb_tree	case_list
	)

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

 {
     cb_tree x;
     char    sbuf[16];
 
     snprintf (sbuf, sizeof(sbuf), "goto %s%d;", CB_PREFIX_LABEL, cb_id);
     x = cb_build_direct (cobc_parse_strdup (sbuf), 0);
     build_evaluate (subject_list, case_list, x);
     snprintf (sbuf, sizeof(sbuf), "%s%d:;", CB_PREFIX_LABEL, cb_id);
     cb_emit (cb_build_comment ("End EVALUATE"));
     cb_emit (cb_build_direct (cobc_parse_strdup (sbuf), 0));
     cb_id++;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_exit ( const unsigned int goback )

Definition at line 5653 of file typeck.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_free ( cb_tree vars )

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

 {
     cb_tree     l;
     struct cb_field *f;
     int     i;
 
     if (cb_validate_list (vars)) {
         return;
     }
     for (l = vars, i = 1; l; l = CB_CHAIN (l), i++) {
         if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_POINTER) {
             if (CB_CAST_P (CB_VALUE (l))) {
                 f = CB_FIELD_PTR (CB_CAST (CB_VALUE(l))->val);
                 if (!f->flag_item_based) {
                     cb_error_x (CB_TREE (current_statement),
                         _("Target %d of FREE is not a BASED data item"), i);
                 }
                 cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
                     CB_BUILD_CAST_ADDRESS (CB_VALUE (l)), NULL));
             } else {
                 cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
                     NULL, CB_BUILD_CAST_ADDRESS (CB_VALUE (l))));
             }
         } else if (CB_REF_OR_FIELD_P (CB_VALUE (l))) {
                 f = CB_FIELD_PTR (CB_VALUE (l));
                 if (!f->flag_item_based) {
                     cb_error_x (CB_TREE (current_statement),
                         _("Target %d of FREE is not a BASED data item"), i);
                 }
                 cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc",
                     CB_BUILD_CAST_ADDR_OF_ADDR (CB_VALUE (l)), NULL));
         } else {
             cb_error_x (CB_TREE (current_statement),
                 _("Target %d of FREE must be a data pointer"), i);
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_get_environment	(	cb_tree	envvar,
		cb_tree	envval
	)

Definition at line 4575 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_emit, and cb_validate_one().

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_goto	(	cb_tree	target,
		cb_tree	depending
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 5665 of file typeck.c.

References cb_build_if(), and cb_emit.

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 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().

 {
     cb_tree     l;
     unsigned int    no_fill_init;
     unsigned int    def_init;
     cb_tree     x;
 
     if (cb_validate_list (vars)) {
         return;
     }
     if (value == NULL && replacing == NULL) {
         def = cb_true;
     }
     no_fill_init = (fillinit == NULL);
     def_init = (def != NULL);
     for (l = vars; l; l = CB_CHAIN (l)) {
         x = CB_VALUE (l);
         if (!(CB_REFERENCE_P (x) && CB_FIELD_P (CB_REFERENCE (x)->value)) &&
             !CB_FIELD_P (x)) {
             cb_error_x (CB_TREE (current_statement), _("Invalid INITIALIZE statement"));
             return;
         }
 
         cb_emit (cb_build_initialize (x , value, replacing,
                           def_init, 1, no_fill_init));
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     switch (CB_TREE_TAG(var)) {
     case CB_TAG_REFERENCE:
         break;
     case CB_TAG_INTRINSIC:
         if (replconv) {
             goto rep_error;
         }
         switch (CB_TREE_CATEGORY(var)) {
         case CB_CATEGORY_ALPHABETIC:
         case CB_CATEGORY_ALPHANUMERIC:
         case CB_CATEGORY_NATIONAL:
             break;
         default:
             cb_error_x (CB_TREE (current_statement),
                     _("Invalid target for %s"), "CONVERTING");
             return;
         }
         break;
     case CB_TAG_LITERAL:
         if (replconv) {
             goto rep_error;
         }
         break;
     default:
         goto rep_error;
     }
     cb_emit (CB_BUILD_FUNCALL_2 ("cob_inspect_init", var, replacing));
     cb_emit_list (body);
     cb_emit (CB_BUILD_FUNCALL_0 ("cob_inspect_finish"));
     return;
 rep_error:
     if (replconv == 1) {
         cb_error_x (CB_TREE (current_statement),
                 _("Invalid target for %s"), "REPLACING");
     } else {
         cb_error_x (CB_TREE (current_statement),
                 _("Invalid target for %s"), "CONVERTING");
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_move	(	cb_tree	src,
		cb_tree	dsts
	)

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

 {
     cb_tree     l;
     cb_tree     x;
     cb_tree     m;
     unsigned int    tempval;
 
     if (cb_validate_one (src)) {
         return;
     }
     if (cb_validate_list (dsts)) {
         return;
     }
 
     cb_check_data_incompat (src);
 
     tempval = 0;
     if (cb_list_length (dsts) > 1) {
         if (CB_INTRINSIC_P (src) || (CB_REFERENCE_P (src) &&
             (CB_REFERENCE (src)->subs || CB_REFERENCE (src)->offset))) {
             tempval = 1;
             cb_emit (CB_BUILD_FUNCALL_1 ("cob_put_indirect_field",
                              src));
         }
     }
 
     for (l = dsts; l; l = CB_CHAIN (l)) {
         x = CB_VALUE (l);
         if (CB_LITERAL_P (x) || CB_CONST_P (x)) {
             cb_error_x (CB_TREE (current_statement),
                     _("Invalid MOVE target - %s"), cb_name (x));
             continue;
         }
         if (!tempval) {
             m = cb_build_move (src, x);
         } else {
             m = CB_BUILD_FUNCALL_1 ("cob_get_indirect_field", x);
         }
         cb_emit (m);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_move_corresponding	(	cb_tree	x1,
		cb_tree	x2
	)

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

 {
     cb_tree     l;
     cb_tree     v;
 
     x1 = cb_check_group_name (x1);
     if (cb_validate_one (x1)) {
         return;
     }
     for (l = x2; l; l = CB_CHAIN(l)) {
         v = CB_VALUE(l);
         v = cb_check_group_name (v);
         if (cb_validate_one (v)) {
             return;
         }
         if (!emit_move_corresponding (x1, v)) {
             if (cb_warn_corresponding) {
                 cb_warning_x (v, _("No CORRESPONDING items found"));
             }
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     struct cb_file  *f;
 
     if (file == cb_error_node) {
         return;
     }
     file = cb_ref (file);
     if (file == cb_error_node) {
         return;
     }
     current_statement->file = file;
     f = CB_FILE (file);
 
     if (f->organization == COB_ORG_SORT) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "OPEN", "SORT");
         return;
     } else if (f->organization == COB_ORG_LINE_SEQUENTIAL &&
            mode == cb_int (COB_OPEN_I_O)) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "OPEN I-O", "LINE SEQUENTIAL");
         return;
     }
     if (sharing == NULL) {
         if (f->sharing) {
             sharing = f->sharing;
         } else {
             sharing = cb_int0;
         }
     }
 
     cb_emit (CB_BUILD_FUNCALL_4 ("cob_open", file, mode,
          sharing, f->file_status));
 
     /* Check for file debugging */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         f->flag_fl_debug) {
         cb_emit (cb_build_debug (cb_debug_name, f->name, NULL));
         cb_emit (cb_build_move (cb_space, cb_debug_contents));
         cb_emit (cb_build_debug_call (f->debug_section));
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_perform	(	cb_tree	perform,
		cb_tree	body
	)

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

 {
     if (perform == cb_error_node) {
         return;
     }
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug && CB_PAIR_P (body)) {
         cb_emit (cb_build_debug (cb_debug_contents, "PERFORM LOOP", NULL));
     }
     CB_PERFORM (perform)->body = body;
     cb_emit (perform);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_read	(	cb_tree	ref,
		cb_tree	next,
		cb_tree	into,
		cb_tree	key,
		cb_tree	lock_opts
	)

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

 {
     cb_tree     file;
     cb_tree     rec;
     cb_tree     x;
     struct cb_file  *f;
     int     read_opts;
 
     read_opts = 0;
     if (lock_opts == cb_int1) {
         read_opts = COB_READ_LOCK;
     } else if (lock_opts == cb_int2) {
         read_opts = COB_READ_NO_LOCK;
     } else if (lock_opts == cb_int3) {
         read_opts = COB_READ_IGNORE_LOCK;
     } else if (lock_opts == cb_int4) {
         read_opts = COB_READ_WAIT_LOCK;
     }
     if (ref == cb_error_node) {
         return;
     }
     file = cb_ref (ref);
     if (file == cb_error_node) {
         return;
     }
     f = CB_FILE (file);
 
     rec = cb_build_field_reference (f->record, ref);
     if (f->organization == COB_ORG_SORT) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "READ", "SORT");
         return;
     }
     if (next == cb_int1 || next == cb_int2 ||
         f->access_mode == COB_ACCESS_SEQUENTIAL) {
         /* READ NEXT/PREVIOUS */
         if (next == cb_int2) {
             switch (f->organization) {
             case COB_ORG_INDEXED:
             case COB_ORG_RELATIVE:
                 break;
             default:
                 cb_error_x (CB_TREE (current_statement),
                 _("READ PREVIOUS not allowed for this file type"));
                 return;
             }
             read_opts |= COB_READ_PREVIOUS;
         } else {
             read_opts |= COB_READ_NEXT;
         }
         if (key) {
             cb_warning (_("KEY ignored with sequential READ"));
         }
         cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
              f->file_status,
              cb_int (read_opts)));
     } else {
         /* READ */
         /* DYNAMIC with [NOT] AT END */
         if (f->access_mode == COB_ACCESS_DYNAMIC &&
             current_statement->handler_id == COB_EC_I_O_AT_END) {
             read_opts |= COB_READ_NEXT;
             cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
                  f->file_status,
                  cb_int (read_opts)));
         } else if (key || f->key) {
             cb_emit (CB_BUILD_FUNCALL_4 ("cob_read",
                  file, key ? key : f->key,
                  f->file_status, cb_int (read_opts)));
         } else {
             cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file,
                  f->file_status,
                  cb_int (read_opts)));
         }
     }
     if (into) {
         current_statement->handler3 = cb_build_move (rec, into);
     }
 
     /* Check for file debugging */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         f->flag_fl_debug) {
         if (into) {
             current_statement->handler3 =
                 CB_LIST_INIT (current_statement->handler3);
         }
         x = cb_build_debug (cb_debug_name, f->name, NULL);
         current_statement->handler3 =
             cb_list_add (current_statement->handler3, x);
         x = cb_build_move (rec, cb_debug_contents);
         current_statement->handler3 =
             cb_list_add (current_statement->handler3, x);
         x = cb_build_debug_call (f->debug_section);
         current_statement->handler3 =
             cb_list_add (current_statement->handler3, x);
     }
     current_statement->file = file;
 }

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

 {
     cb_emit (CB_BUILD_FUNCALL_0 ("cob_ready_trace"));
 }

Here is the caller graph for this function:

void cb_emit_release	(	cb_tree	record,
		cb_tree	from
	)

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

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

Here is the call graph for this function:

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

 {
     cb_emit (CB_BUILD_FUNCALL_0 ("cob_reset_trace"));
 }

Here is the caller graph for this function:

void cb_emit_return	(	cb_tree	ref,
		cb_tree	into
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     cb_tree     file;
     struct cb_file  *f;
     int     opts;
 
     if (cb_validate_one (record)) {
         return;
     }
     if (cb_validate_one (from)) {
         return;
     }
     if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
         cb_error_x (CB_TREE (current_statement),
             _("%s requires a record name as subject"), "REWRITE");
         return;
     }
     if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) {
         cb_error_x (CB_TREE (current_statement),
             _("%s subject does not refer to a record name"), "REWRITE");
         return;
     }
 
     file = CB_TREE (CB_FIELD (cb_ref (record))->file);
     if (!file || file == cb_error_node) {
         return;
     }
     current_statement->file = file;
     f = CB_FILE (file);
     opts = 0;
 
     if (f->organization == COB_ORG_SORT) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "REWRITE", "SORT");
         return;
     } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "REWRITE", "LINE SEQUENTIAL");
         return;
     } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY &&
           (f->organization != COB_ORG_RELATIVE &&
            f->organization != COB_ORG_INDEXED)) {
             cb_error_x (CB_TREE(current_statement),
             _("INVALID KEY clause invalid with this file type"));
         return;
     } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && lockopt) {
         cb_error_x (CB_TREE (current_statement),
         _("LOCK clause invalid with file LOCK AUTOMATIC"));
         return;
     } else if (lockopt == cb_int1) {
         opts = COB_WRITE_LOCK;
     }
 
     if (from) {
         cb_emit (cb_build_move (from, record));
     }
 
     /* Check debugging on record name */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         CB_FIELD_PTR (record)->flag_field_debug) {
         cb_emit (cb_build_debug (cb_debug_name,
                      CB_FIELD_PTR (record)->name, NULL));
         cb_emit (cb_build_move (record, cb_debug_contents));
         cb_emit (cb_build_debug_call (CB_FIELD_PTR (record)->debug_section));
     }
     cb_emit (CB_BUILD_FUNCALL_4 ("cob_rewrite", file, record,
             cb_int (opts), f->file_status));
 }

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

 {
     cb_emit (CB_BUILD_FUNCALL_0 ("cob_rollback"));
 }

Here is the caller graph for this function:

void cb_emit_search	(	cb_tree	table,
		cb_tree	varying,
		cb_tree	at_end,
		cb_tree	whens
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 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().

 {
     cb_tree     x;
     cb_tree     stmt_lis;
 
     if (cb_validate_one (table)) {
         return;
     }
     if (table == cb_error_node) {
         return;
     }
     if (when == cb_error_node) {
         return;
     }
     x = cb_build_search_all (table, when);
     if (!x) {
         return;
     }
 
     stmt_lis = cb_check_needs_break (stmts);
     cb_emit (cb_build_search (1, table, NULL,
                   cb_check_needs_break (at_end),
                   cb_build_if (x, stmt_lis, NULL, 0)));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_attribute	(	cb_tree	x,
		const int	val_on,
		const int	val_off
	)

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

 {
     struct cb_field     *f;
 
     if (cb_validate_one (x)) {
         return;
     }
     if (!CB_REF_OR_FIELD_P (cb_ref (x))) {
         cb_error_x (CB_TREE (current_statement),
             _("SET ATTRIBUTE requires a screen item as subject"));
         return;
     }
     f = CB_FIELD_PTR (x);
     if (f->storage != CB_STORAGE_SCREEN) {
         cb_error_x (CB_TREE (current_statement),
             _("SET ATTRIBUTE subject does not refer to a screen item"));
         return;
     }
     cb_emit (cb_build_set_attribute (f, val_on, val_off));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_false ( cb_tree l )

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

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

Here is the call graph for this function:

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

 {
     cb_emit (CB_BUILD_FUNCALL_1 ("cob_set_exception", cb_int0));
 }

Here is the caller graph for this function:

void cb_emit_set_on_off	(	cb_tree	l,
		cb_tree	flag
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_to	(	cb_tree	vars,
		cb_tree	x
	)

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

 {
     cb_tree     l;
     cb_tree     v;
     struct cb_cast  *p;
     enum cb_class   class;
 
     if (cb_validate_one (x)) {
         return;
     }
     if (cb_validate_list (vars)) {
         return;
     }
 
 #if 0   /* RXWRXW - target check */
     /* Determine class of targets */
     for (l = vars; l; l = CB_CHAIN (l)) {
         if (CB_TREE_CLASS (CB_VALUE (l)) != CB_CLASS_UNKNOWN) {
             if (class == CB_CLASS_UNKNOWN) {
                 class = CB_TREE_CLASS (CB_VALUE (l));
             } else if (class != CB_TREE_CLASS (CB_VALUE (l))) {
                 break;
             }
         }
     }
     if (l || (class != CB_CLASS_INDEX && class != CB_CLASS_POINTER)) {
         cb_error_x (CB_TREE (current_statement),
                 _("The targets of SET must be either indexes or pointers"));
         return;
     }
 #endif
 
     if (CB_CAST_P (x)) {
         p = CB_CAST (x);
         if (p->cast_type == CB_CAST_PROGRAM_POINTER) {
             for (l = vars; l; l = CB_CHAIN (l)) {
                 v = CB_VALUE (l);
                 if (!CB_REFERENCE_P (v)) {
                     cb_error_x (CB_TREE (current_statement),
                     _("SET targets must be PROGRAM-POINTER"));
                     CB_VALUE (l) = cb_error_node;
                 } else if (CB_FIELD(cb_ref(v))->usage != CB_USAGE_PROGRAM_POINTER) {
                     cb_error_x (CB_TREE (current_statement),
                     _("SET targets must be PROGRAM-POINTER"));
                     CB_VALUE (l) = cb_error_node;
                 }
             }
         }
     }
     /* Validate the targets */
     for (l = vars; l; l = CB_CHAIN (l)) {
         v = CB_VALUE (l);
         if (!CB_CAST_P (v)) {
             continue;
         }
         p = CB_CAST (v);
         if (p->cast_type == CB_CAST_ADDRESS &&
             !CB_FIELD (cb_ref (p->val))->flag_item_based &&
             CB_FIELD (cb_ref (p->val))->storage != CB_STORAGE_LINKAGE) {
             cb_error_x (p->val, _("The address of '%s' cannot be changed"),
                     cb_name (p->val));
             CB_VALUE (l) = cb_error_node;
         }
     }
     if (cb_validate_list (vars)) {
         return;
     }
 
     for (l = vars; l; l = CB_CHAIN (l)) {
         class = cb_tree_class (CB_VALUE (l));
         switch (class) {
         case CB_CLASS_INDEX:
         case CB_CLASS_NUMERIC:
         case CB_CLASS_POINTER:
             cb_check_data_incompat (x);
             cb_emit (cb_build_move (x, CB_VALUE (l)));
             break;
         default:
             cb_error_x (CB_TREE (current_statement),
                     _("SET target is invalid - '%s'"),
                     cb_name (CB_VALUE(l)));
             break;
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_set_true ( cb_tree l )

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_setenv	(	cb_tree	x,
		cb_tree	y
	)

Definition at line 8013 of file typeck.c.

References CB_BUILD_FUNCALL_2, and cb_emit.

Referenced by yyparse().

 {
     cb_emit (CB_BUILD_FUNCALL_2 ("cob_set_environment", x, y));
 }

Here is the caller graph for this function:

void cb_emit_sort_finish ( cb_tree file )

Definition at line 8356 of file typeck.c.

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

Referenced by yyparse().

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

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_giving	(	cb_tree	file,
		cb_tree	l
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     cb_tree         l;
     struct cb_field     *f;
 
     if (cb_validate_list (keys)) {
         return;
     }
     if (cb_ref (name) == cb_error_node) {
         return;
     }
     for (l = keys; l; l = CB_CHAIN (l)) {
         if (CB_VALUE (l) == NULL) {
             CB_VALUE (l) = name;
         }
         cb_ref (CB_VALUE (l));
     }
 
     if (CB_FILE_P (cb_ref (name))) {
         if (CB_FILE (cb_ref (name))->organization != COB_ORG_SORT) {
             cb_error_x (name, _("Invalid SORT filename"));
         }
         CB_FIELD_PTR (current_program->cb_sort_return)->count++;
         cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", cb_ref (name),
                          cb_int (cb_list_length (keys)), col,
                          CB_BUILD_CAST_ADDRESS (current_program->cb_sort_return),
                          CB_FILE(cb_ref (name))->file_status));
         for (l = keys; l; l = CB_CHAIN (l)) {
             cb_emit (CB_BUILD_FUNCALL_4 ("cob_file_sort_init_key",
                     cb_ref (name),
                     CB_VALUE (l),
                     CB_PURPOSE (l),
                     cb_int (CB_FIELD_PTR (CB_VALUE(l))->offset)));
         }
     } else {
         if (keys == NULL) {
             cb_error_x (name, _("Table sort without keys not implemented yet"));
         }
         cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort_init",
                          cb_int (cb_list_length (keys)), col));
         for (l = keys; l; l = CB_CHAIN (l)) {
             cb_emit (CB_BUILD_FUNCALL_3 ("cob_table_sort_init_key",
                     CB_VALUE (l),
                     CB_PURPOSE (l),
                     cb_int(CB_FIELD_PTR (CB_VALUE(l))->offset
                            - CB_FIELD_PTR (CB_VALUE(l))->parent->offset)));
         }
         f = CB_FIELD (cb_ref (name));
         cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort", name,
                          (f->depending
                           ? cb_build_cast_int (f->depending)
                           : cb_int (f->occurs_max))));
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_input ( cb_tree proc )

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

 {
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug) {
         cb_emit (cb_build_debug (cb_debug_contents, "SORT INPUT", NULL));
     }
     cb_emit (cb_build_perform_once (proc));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_output ( cb_tree proc )

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

 {
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug) {
         if (current_statement->flag_merge) {
             cb_emit (cb_build_debug (cb_debug_contents,
                          "MERGE OUTPUT", NULL));
         } else {
             cb_emit (cb_build_debug (cb_debug_contents,
                          "SORT OUTPUT", NULL));
         }
     }
     cb_emit (cb_build_perform_once (proc));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_sort_using	(	cb_tree	file,
		cb_tree	l
	)

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     cb_tree         kfld;
     cb_tree         fl;
     cb_tree         cbtkey;
     struct cb_file      *f;
 
     if (cb_validate_one (key)) {
         return;
     }
     if (cb_validate_one (keylen)) {
         return;
     }
     if (file == cb_error_node) {
         return;
     }
     fl = cb_ref (file);
     if (fl == cb_error_node) {
         return;
     }
     f = CB_FILE (fl);
 
     if (f->organization != COB_ORG_INDEXED &&
         f->organization != COB_ORG_RELATIVE) {
         cb_error_x (CB_TREE (current_statement),
                 _("%s not allowed on %s files"), "START", "SEQUENTIAL");
         return;
     }
     if (keylen && f->organization != COB_ORG_INDEXED) {
         cb_error_x (CB_TREE (current_statement),
                 _("LENGTH/SIZE clause only allowed on INDEXED files"));
         return;
     }
     if (f->access_mode == COB_ACCESS_RANDOM) {
         cb_error_x (CB_TREE (current_statement),
                 _("START not allowed with ACCESS MODE RANDOM"));
         return;
     }
 
     current_statement->file = fl;
     if (key) {
         kfld = cb_ref (key);
         if (kfld == cb_error_node) {
             return;
         }
         if (check_valid_key (f, CB_FIELD_PTR (kfld))) {
             return;
         }
         cbtkey = key;
     } else {
         cbtkey = f->key;
     }
 
     /* Check for file debugging */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         f->flag_fl_debug) {
         /* Gen callback after start but before exception test */
         current_statement->flag_callback = 1;
     }
 
     cb_emit (CB_BUILD_FUNCALL_5 ("cob_start", fl, op, cbtkey, keylen,
                      f->file_status));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_stop_run ( cb_tree x )

Definition at line 8482 of file typeck.c.

References cb_build_cast_int(), CB_BUILD_FUNCALL_1, and cb_emit.

Referenced by yyparse().

 {
     cb_emit (CB_BUILD_FUNCALL_1 ("cob_stop_run", cb_build_cast_int (x)));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_string	(	cb_tree	items,
		cb_tree	into,
		cb_tree	pointer
	)

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

 {
     cb_tree start;
     cb_tree l;
     cb_tree end;
     cb_tree dlm;
 
     if (cb_validate_one (into)) {
         return;
     }
     if (cb_validate_one (pointer)) {
         return;
     }
     start = items;
     cb_emit (CB_BUILD_FUNCALL_2 ("cob_string_init", into, pointer));
     while (start) {
 
         /* Find DELIMITED item */
         for (end = start; end; end = CB_CHAIN (end)) {
             if (CB_PAIR_P (CB_VALUE (end))) {
                 break;
             }
         }
 
         /* cob_string_delimited */
         dlm = end ? CB_PAIR_X (CB_VALUE (end)) : NULL;
         if (dlm == cb_int0) {
             dlm = NULL;
         }
         cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_delimited", dlm));
 
         /* cob_string_append */
         for (l = start; l != end; l = CB_CHAIN (l)) {
             cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_append",
                              CB_VALUE (l)));
         }
 
         start = end ? CB_CHAIN (end) : NULL;
     }
     cb_emit (CB_BUILD_FUNCALL_0 ("cob_string_finish"));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_emit_unlock ( cb_tree ref )

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

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 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().

 {
     if (cb_validate_one (name)) {
         return;
     }
     if (cb_validate_one (tallying)) {
         return;
     }
     if (cb_validate_list (delimited)) {
         return;
     }
     if (cb_validate_list (into)) {
         return;
     }
     cb_emit (CB_BUILD_FUNCALL_3 ("cob_unstring_init", name, pointer,
         cb_int (cb_list_length (delimited))));
     cb_emit_list (delimited);
     cb_emit_list (into);
     if (tallying) {
         cb_emit (CB_BUILD_FUNCALL_1 ("cob_unstring_tallying", tallying));
     }
     cb_emit (CB_BUILD_FUNCALL_0 ("cob_unstring_finish"));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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

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

 {
     cb_tree     file;
     cb_tree     check_eop;
     struct cb_file  *f;
 
     if (cb_validate_one (record)) {
         return;
     }
     if (cb_validate_one (from)) {
         return;
     }
     if (!CB_REF_OR_FIELD_P (cb_ref (record))) {
         cb_error_x (CB_TREE (current_statement),
             _("%s requires a record name as subject"), "WRITE");
         return;
     }
     if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) {
         cb_error_x (CB_TREE (current_statement),
             _("%s subject does not refer to a record name"), "WRITE");
         return;
     }
     file = CB_TREE (CB_FIELD (cb_ref (record))->file);
     if (!file || file == cb_error_node) {
         return;
     }
     current_statement->file = file;
     f = CB_FILE (file);
 
     if (f->organization == COB_ORG_SORT) {
         cb_error_x (CB_TREE (current_statement),
         _("%s not allowed on %s files"), "WRITE", "SORT");
     } else if (current_statement->handler_id == COB_EC_I_O_INVALID_KEY &&
           (f->organization != COB_ORG_RELATIVE &&
            f->organization != COB_ORG_INDEXED)) {
             cb_error_x (CB_TREE(current_statement),
             _("INVALID KEY clause invalid with this file type"));
     } else if (lockopt) {
         if (f->lock_mode & COB_LOCK_AUTOMATIC) {
             cb_error_x (CB_TREE (current_statement),
             _("LOCK clause invalid with file LOCK AUTOMATIC"));
         } else if (opt != cb_int0) {
             cb_error_x (CB_TREE (current_statement),
             _("LOCK clause invalid here"));
         } else if (lockopt == cb_int1) {
             opt = cb_int (COB_WRITE_LOCK);
         }
     }
 
     if (from) {
         cb_emit (cb_build_move (from, record));
     }
 
     /* Check debugging on record name */
     if (current_program->flag_debugging &&
         !current_statement->flag_in_debug &&
         CB_FIELD_PTR (record)->flag_field_debug) {
         cb_emit (cb_build_debug (cb_debug_name,
                      CB_FIELD_PTR (record)->name, NULL));
         cb_emit (cb_build_move (record, cb_debug_contents));
         cb_emit (cb_build_debug_call (CB_FIELD_PTR (record)->debug_section));
     }
     if (f->organization == COB_ORG_LINE_SEQUENTIAL &&
         opt == cb_int0) {
         if (cb_flag_write_after || CB_FILE (file)->flag_line_adv) {
             opt = cb_int_hex (COB_WRITE_AFTER | COB_WRITE_LINES | 1);
         } else {
             opt = cb_int_hex (COB_WRITE_BEFORE | COB_WRITE_LINES | 1);
         }
     }
     if (current_statement->handler_id == COB_EC_I_O_EOP &&
         current_statement->handler1) {
         check_eop = cb_int1;
     } else {
         check_eop = cb_int0;
     }
     cb_emit (CB_BUILD_FUNCALL_5 ("cob_write", file, record, opt,
                      f->file_status, check_eop));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

char* cb_encode_program_id ( const char * name )

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

 {
     unsigned char       *p;
     const unsigned char *s;
     const unsigned char *t;
     unsigned char       buff[COB_MINI_BUFF];
 
     s = NULL;
     for (t = (const unsigned char *)name; *t; t++) {
         if (*t == (unsigned char)'/' || *t == (unsigned char)'\\') {
             s = t + 1;
         }
     }
     if (!s) {
         s = (const unsigned char *)name;
     }
     p = buff;
     /* Encode the initial digit */
     if (*s <= (unsigned char)'9' && *s >= (unsigned char)'0') {
         *p++ = (unsigned char)'_';
     }
     /* Encode invalid letters */
     for (; *s; s++) {
         if (likely(valid_char[*s])) {
             *p++ = *s;
         } else {
             *p++ = (unsigned char)'_';
             if (*s == (unsigned char)'-') {
                 *p++ = (unsigned char)'_';
             } else {
                 *p++ = hexval[*s / 16U];
                 *p++ = hexval[*s % 16U];
             }
         }
     }
     *p = 0;
 
     /* Check case folding */
     if (unlikely(cb_fold_call)) {
         if (cb_fold_call == COB_FOLD_UPPER) {
             for (p = buff; *p; p++) {
                 if (islower (*p)) {
                     *p = (cob_u8_t)toupper (*p);
                 }
             }
         } else if (cb_fold_call == COB_FOLD_LOWER) {
             for (p = buff; *p; p++) {
                 if (isupper (*p)) {
                     *p = (cob_u8_t)tolower (*p);
                 }
             }
         }
     }
 
     return cobc_check_string ((char *)buff);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree cb_expr_finish ( void )

static

Definition at line 3108 of file typeck.c.

References _, cb_error(), cb_error_node, cb_error_x(), cb_exp_line, cb_source_file, expr_expand(), expr_index, expr_reduce(), cb_tree_common::source_file, cb_tree_common::source_line, value, and expr_node::value.

Referenced by cb_build_expr().

 {
     /* Reduce all */
     (void)expr_reduce (0);
 
     if (!expr_stack[3].value) {
         cb_error (_("Invalid expression"));
         return cb_error_node;
     }
 
     expr_stack[3].value->source_file = cb_source_file;
     expr_stack[3].value->source_line = cb_exp_line;
 
     if (expr_index != 4) {
         cb_error_x (expr_stack[3].value, _("Invalid expression"));
         return cb_error_node;
     }
 
     expr_expand (&expr_stack[3].value);
     if (expr_stack[3].token != 'x') {
         cb_error_x (expr_stack[3].value, _("Invalid expression"));
         return cb_error_node;
     }
 
     return expr_stack[3].value;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void cb_expr_init ( void )

static

Definition at line 2714 of file typeck.c.

References cobc_main_malloc(), expr_index, expr_op, expr_stack_size, initialized, NULL, and START_STACK_SIZE.

Referenced by cb_build_expr().

 {
     if (initialized == 0) {
         initialized = 1;
         /* Init stack */
         expr_stack_size = START_STACK_SIZE;
         expr_stack = cobc_main_malloc (sizeof (struct expr_node) * START_STACK_SIZE);
     } else {
         memset (expr_stack, 0, expr_stack_size * sizeof (struct expr_node));
     }
     expr_op = 0;
     expr_lh = NULL;
     /* First three entries are dummies */
     expr_index = 3;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void cb_expr_shift	(	int	token,
		cb_tree	value
	)

static

Definition at line 2970 of file typeck.c.

References cb_build_binary_op(), CB_BUILD_PARENTHESIS, cb_expr_shift_sign(), cb_zero, cobc_main_realloc(), expr_index, expr_op, expr_reduce(), expr_stack_size, TOKEN, value, and VALUE.

Referenced by cb_build_expr().

 {
     switch (token) {
     case 'M':
         break;
     case 'x':
         /* Sign ZERO condition */
         if (value == cb_zero) {
             if (TOKEN (-1) == 'x' || TOKEN (-1) == '!') {
                 cb_expr_shift_sign ('=');
                 return;
             }
         }
 
         /* Unary sign */
         if ((TOKEN (-1) == '+' || TOKEN (-1) == '-') &&
             TOKEN (-2) != 'x') {
             if (TOKEN (-1) == '-') {
                 value = cb_build_binary_op (cb_zero, '-', value);
             }
             expr_index -= 1;
         }
         break;
 
     case '(':
         /* 'x' op '(' --> '(' 'x' op */
         switch (TOKEN (-1)) {
         case '=':
         case '~':
         case '<':
         case '>':
         case '[':
         case ']':
             expr_op = TOKEN (-1);
             if (TOKEN (-2) == 'x') {
                 expr_lh = VALUE (-2);
             }
             break;
         default:
             break;
         }
         break;
 
     case ')':
         /* Enclosed by parentheses */
         (void)expr_reduce (token);
         if (TOKEN (-2) == '(') {
             value = CB_BUILD_PARENTHESIS (VALUE (-1));
             expr_index -= 2;
             cb_expr_shift ('x', value);
             return;
         }
         break;
 
     default:
         /* '<' '|' '=' --> '[' */
         /* '>' '|' '=' --> ']' */
         if (token == '=' && TOKEN (-1) == '|' &&
             (TOKEN (-2) == '<' || TOKEN (-2) == '>')) {
             token = (TOKEN (-2) == '<') ? '[' : ']';
             expr_index -= 2;
         }
 
         /* '!' '=' --> '~', etc. */
         if (TOKEN (-1) == '!') {
             switch (token) {
             case '=':
                 token = '~';
                 expr_index--;
                 break;
             case '~':
                 token = '=';
                 expr_index--;
                 break;
             case '<':
                 token = ']';
                 expr_index--;
                 break;
             case '>':
                 token = '[';
                 expr_index--;
                 break;
             case '[':
                 token = '>';
                 expr_index--;
                 break;
             case ']':
                 token = '<';
                 expr_index--;
                 break;
             default:
                 break;
             }
         }
         break;
     }
 
     /* Reduce */
     /* Catch invalid condition */
     if (expr_reduce (token) > 0) {
         return;
     }
 
     /* Allocate sufficient stack memory */
     if (expr_index >= expr_stack_size) {
         while (expr_stack_size <= expr_index) {
             expr_stack_size *= 2;
         }
         expr_stack = cobc_main_realloc (expr_stack, sizeof (struct expr_node) * expr_stack_size);
     }
 
     /* Put on the stack */
     TOKEN (0) = token;
     VALUE (0) = value;
     expr_index++;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void cb_expr_shift_class ( const char * name )

static

Definition at line 2950 of file typeck.c.

References CB_BUILD_FUNCALL_1, CB_BUILD_NEGATION, expr_index, expr_reduce(), TOKEN, and VALUE.

Referenced by cb_build_expr().

 {
     int have_not;
 
     if (TOKEN (-1) == '!') {
         have_not = 1;
         expr_index--;
     } else {
         have_not = 0;
     }
     (void)expr_reduce ('=');
     if (TOKEN (-1) == 'x') {
         VALUE (-1) = CB_BUILD_FUNCALL_1 (name, VALUE (-1));
         if (have_not) {
             VALUE (-1) = CB_BUILD_NEGATION (VALUE (-1));
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void cb_expr_shift_sign ( const int op )

static

Definition at line 2930 of file typeck.c.

References cb_build_binary_op(), CB_BUILD_NEGATION, cb_zero, expr_index, expr_reduce(), TOKEN, and VALUE.

Referenced by cb_build_expr(), and cb_expr_shift().

 {
     int have_not;
 
     if (TOKEN (-1) == '!') {
         have_not = 1;
         expr_index--;
     } else {
         have_not = 0;
     }
     (void)expr_reduce ('=');
     if (TOKEN (-1) == 'x') {
         VALUE (-1) = cb_build_binary_op (VALUE (-1), op, cb_zero);
         if (have_not) {
             VALUE (-1) = CB_BUILD_NEGATION (VALUE (-1));
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int cb_field_size ( const cb_tree x )

static

Definition at line 790 of file typeck.c.

References _, CB_FIELD, cb_get_int(), CB_LITERAL, CB_LITERAL_P, CB_REFERENCE, CB_TAG_FIELD, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_TAG, cobc_abort_pr(), COBC_DUMB_ABORT, cb_reference::length, cb_reference::offset, cb_field::size, and cb_reference::value.

Referenced by cb_build_cond(), cb_build_length(), cb_build_length_1(), cb_build_memset(), cb_build_move_copy(), cb_build_move_field(), cb_check_overlapping(), cb_chk_alpha_cond(), and validate_move().

 {
     struct cb_reference *r;
     struct cb_field     *f;
 
     switch (CB_TREE_TAG (x)) {
     case CB_TAG_LITERAL:
         return CB_LITERAL (x)->size;
     case CB_TAG_FIELD:
         return CB_FIELD (x)->size;
     case CB_TAG_REFERENCE:
         r = CB_REFERENCE (x);
         f = CB_FIELD (r->value);
 
         if (r->length) {
             if (CB_LITERAL_P (r->length)) {
                 return cb_get_int (r->length);
             } else {
                 return -1;
             }
         } else if (r->offset) {
             if (CB_LITERAL_P (r->offset)) {
                 return f->size - cb_get_int (r->offset) + 1;
             } else {
                 return -1;
             }
         } else {
             return f->size;
         }
     default:
         cobc_abort_pr (_("Unexpected tree tag %d"), (int)CB_TREE_TAG (x));
         /* Use dumb variant */
         COBC_DUMB_ABORT ();
     }
     /* NOT REACHED */
 #ifndef _MSC_VER
     return 0;
 #endif
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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
	)

static

Definition at line 4316 of file typeck.c.

References CB_BUILD_FUNCALL_10, cb_emit, cb_int(), CB_LIST_P, CB_PAIR_X, CB_PAIR_Y, line, NULL, and valid_screen_pos().

Referenced by cb_emit_accept().

 {
     cb_tree     line;
     cb_tree     column;
 
     if (!pos) {
         cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept",
             var, NULL, NULL, fgc, bgc, scroll,
             timeout, prompt, size_is, cb_int (dispattrs)));
     } else if (CB_LIST_P (pos)) {
         line = CB_PAIR_X (pos);
         column = CB_PAIR_Y (pos);
         cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept",
             var, line, column, fgc, bgc, scroll,
             timeout, prompt, size_is, cb_int (dispattrs)));
     } else if (valid_screen_pos (pos)) {
         cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept",
             var, pos, NULL, fgc, bgc, scroll,
             timeout, prompt, size_is, cb_int (dispattrs)));
     }
 }

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

 {
     inspect_func = NULL;
     inspect_data = NULL;
 }

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

 {
     const struct system_table   *psyst;
     const char          *s;
     size_t              n;
 
     putchar ('\n');
     printf (_("System routine\t\t\tParameters"));
     puts ("\n");
     for (psyst = system_tab; psyst->syst_name; psyst++) {
         switch (*(unsigned char *)(psyst->syst_name)) {
         case 'C':
         case 'S':
             printf ("%s", psyst->syst_name);
             break;
         case 0xF4:
             printf ("X\"F4\"");
             break;
         case 0xF5:
             printf ("X\"F5\"");
             break;
         case 0x91:
             printf ("X\"91\"");
             break;
         case 0xE4:
             printf ("X\"E4\"");
             break;
         case 0xE5:
             printf ("X\"E5\"");
             break;
         default:
             break;
         }
         n = strlen (psyst->syst_name);
         switch (n / 8) {
         case 0:
             s = "\t\t\t\t";
             break;
         case 1:
             s = "\t\t\t";
             break;
         case 2:
             s = "\t\t";
             break;
         default:
             s = "\t";
             break;
         }
         printf ("%s%d\n", s, psyst->syst_params);
     }
 }

Here is the caller graph for this function:

static void cb_validate_collating ( struct cb_program * prog )

static

Definition at line 1864 of file typeck.c.

References _, CB_ALPHABET_CUSTOM, CB_ALPHABET_NAME, CB_ALPHABET_NAME_P, cb_build_alphanumeric_literal(), cb_error_x(), cb_high, CB_LITERAL, cb_low, cb_name(), cb_ref(), cb_program::collating_sequence, and NULL.

Referenced by cb_validate_program_environment().

 {
     cb_tree     x;
 
     x = cb_ref (prog->collating_sequence);
     if (!CB_ALPHABET_NAME_P (x)) {
         cb_error_x (prog->collating_sequence, _("'%s' is not an alphabet name"),
                 cb_name (prog->collating_sequence));
         prog->collating_sequence = NULL;
         return;
     }
     if (CB_ALPHABET_NAME (x)->alphabet_type != CB_ALPHABET_CUSTOM) {
         return;
     }
     if (CB_ALPHABET_NAME (x)->low_val_char) {
         cb_low = cb_build_alphanumeric_literal ("\0", (size_t)1);
         CB_LITERAL(cb_low)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char;
         CB_LITERAL(cb_low)->all = 1;
     }
     if (CB_ALPHABET_NAME (x)->high_val_char != 255){
         cb_high = cb_build_alphanumeric_literal ("\0", (size_t)1);
         CB_LITERAL(cb_high)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char;
         CB_LITERAL(cb_high)->all = 1;
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static size_t cb_validate_list ( cb_tree l )

static

Definition at line 581 of file typeck.c.

References CB_CHAIN, cb_validate_one(), and CB_VALUE.

Referenced by cb_emit_arithmetic(), cb_emit_display(), cb_emit_free(), cb_emit_initialize(), cb_emit_move(), cb_emit_set_on_off(), cb_emit_set_to(), cb_emit_set_up_down(), cb_emit_sort_giving(), cb_emit_sort_init(), cb_emit_sort_using(), and cb_emit_unstring().

 {
     for (; l; l = CB_CHAIN (l)) {
         if (cb_validate_one (CB_VALUE (l))) {
             return 1;
         }
     }
     return 0;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static size_t cb_validate_one ( cb_tree x )

static

Definition at line 545 of file typeck.c.

References _, cb_error_node, cb_error_x(), CB_FIELD, CB_FIELD_P, cb_ref(), CB_REFERENCE_P, cb_field::flag_invalid, cb_field::level, and cb_field::odo_level.

Referenced by cb_build_unstring_delimited(), cb_build_unstring_into(), cb_emit_accept(), cb_emit_accept_arg_number(), cb_emit_accept_arg_value(), cb_emit_accept_command_line(), cb_emit_accept_date(), cb_emit_accept_date_yyyymmdd(), cb_emit_accept_day(), cb_emit_accept_day_of_week(), cb_emit_accept_day_yyyyddd(), cb_emit_accept_environment(), cb_emit_accept_escape_key(), cb_emit_accept_exception_status(), cb_emit_accept_line_or_col(), cb_emit_accept_mnemonic(), cb_emit_accept_name(), cb_emit_accept_time(), cb_emit_accept_user_name(), cb_emit_allocate(), cb_emit_arg_number(), cb_emit_arithmetic(), cb_emit_cancel(), cb_emit_command_line(), cb_emit_corresponding(), cb_emit_divide(), cb_emit_env_name(), cb_emit_env_value(), cb_emit_get_environment(), cb_emit_move(), cb_emit_move_corresponding(), cb_emit_release(), cb_emit_return(), cb_emit_rewrite(), cb_emit_search(), cb_emit_search_all(), cb_emit_set_attribute(), cb_emit_set_to(), cb_emit_set_up_down(), cb_emit_start(), cb_emit_string(), cb_emit_unstring(), cb_emit_write(), cb_validate_list(), and validate_attrs().

 {
     cb_tree     y;
     struct cb_field     *f;
 
     if (x == cb_error_node) {
         return 1;
     }
     if (!x) {
         return 0;
     }
     if (CB_REFERENCE_P (x)) {
         y = cb_ref (x);
         if (y == cb_error_node) {
             return 1;
         }
         if (CB_FIELD_P (y)) {
             f = CB_FIELD (y);
             if (f->level == 88) {
                 cb_error_x (x, _("Invalid use of 88 level item"));
                 return 1;
             }
             if (f->flag_invalid) {
                 return 1;
             }
             /* check for nested ODO */
             if (f->odo_level > 1) {
                 cb_error_x (x, _("'%s' not implemented"),
                     _("Reference to item containing nested ODO"));
             }
         }
     }
     return 0;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_program_body ( struct cb_program * prog )

Definition at line 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().

 {
     cb_tree         l;
     cb_tree         x;
     cb_tree         v;
     struct cb_label     *save_section;
     struct cb_label     *save_paragraph;
     struct cb_alter_id  *aid;
     struct cb_label     *l1;
     struct cb_label     *l2;
     struct cb_field     *f;
     int         size;
 
     /* Resolve all labels */
     save_section = current_section;
     save_paragraph = current_paragraph;
     for (l = cb_list_reverse (prog->label_list); l; l = CB_CHAIN (l)) {
         x = CB_VALUE (l);
         current_section = CB_REFERENCE (x)->section;
         current_paragraph = CB_REFERENCE (x)->paragraph;
         v = cb_ref (x);
         /* Check refs in to / out of DECLARATIVES */
         if (CB_LABEL_P (v)) {
             if (CB_REFERENCE (x)->flag_in_decl &&
                 !CB_LABEL (v)->flag_declaratives) {
                 if (!cb_relaxed_syntax_check) {
                     cb_error_x (x, _("'%s' is not in DECLARATIVES"),
                             CB_LABEL (v)->name);
                 } else {
                     cb_warning_x (x, _("'%s' is not in DECLARATIVES"),
                             CB_LABEL (v)->name);
                 }
             }
             if (CB_LABEL (v)->flag_declaratives &&
                 !CB_REFERENCE (x)->flag_in_decl &&
                 !CB_REFERENCE (x)->flag_decl_ok) {
                 cb_error_x (x, _("Invalid reference to '%s' (In DECLARATIVES)"), CB_LABEL (v)->name);
             }
             CB_LABEL (v)->flag_begin = 1;
             if (CB_REFERENCE (x)->length) {
                 CB_LABEL (v)->flag_return = 1;
             }
         } else if (v != cb_error_node) {
             cb_error_x (x, _("'%s' not a procedure name"), cb_name (x));
         }
     }
 
     /* Resolve DEBUG references */
     /* For data items, we may need to adjust the size of DEBUG-CONTENTS */
     /* Basic size of DEBUG-CONTENTS is 31 */
     size = 31;
     for (l = prog->debug_list; l; l = CB_CHAIN (l)) {
         x = CB_VALUE (l);
         current_section = CB_REFERENCE (x)->section;
         current_paragraph = CB_REFERENCE (x)->paragraph;
         v = cb_ref (x);
         if (v == cb_error_node) {
             continue;
         }
         switch (CB_TREE_TAG (v)) {
         case CB_TAG_LABEL:
             if (current_program->all_procedure) {
                 cb_error_x (x, _("'%s' - DEBUGGING target invalid with ALL PROCEDURES"),
                         cb_name (x));
             }
             if (!CB_LABEL (v)->flag_real_label) {
                 cb_error_x (x, _("'%s' - DEBUGGING target invalid"),
                         cb_name (x));
             }
             CB_LABEL (v)->debug_section =
                 CB_REFERENCE (x)->debug_section;
             CB_LABEL (v)->flag_debugging_mode = 1;
             break;
         case CB_TAG_FILE:
             break;
         case CB_TAG_FIELD:
             if (CB_FIELD (v)->size > size) {
                 size = CB_FIELD (v)->size;
             }
             break;
         default:
             cb_error_x (x, _("'%s' is not a valid DEBUGGING target"),
                     cb_name (x));
             break;
         }
     }
     /* If necessary, adjust size of DEBUG-CONTENTS (and DEBUG-ITEM) */
     if (current_program->flag_debugging) {
         if (size != 31) {
             f = CB_FIELD_PTR (cb_debug_contents);
             f->size = size;
             f->memory_size = size;
             size -= 31;
             f = CB_FIELD_PTR (cb_debug_item);
             f->size += size;
             f->memory_size += size;
         }
     }
 
     /* Build ALTER ids - We need to remove duplicates */
     for (l = prog->alter_list; l; l = CB_CHAIN (l)) {
         if (CB_PURPOSE (l) == cb_error_node) {
             continue;
         }
         if (CB_VALUE (l) == cb_error_node) {
             continue;
         }
         x = CB_PURPOSE (l);
         v = CB_VALUE (l);
         if (CB_REFERENCE (x)->value == cb_error_node) {
             continue;
         }
         if (CB_REFERENCE (v)->value == cb_error_node) {
             continue;
         }
         l1 = CB_LABEL (CB_REFERENCE (x)->value);
         l2 = CB_LABEL (CB_REFERENCE (v)->value);
         current_section = CB_REFERENCE (x)->section;
         current_paragraph = CB_REFERENCE (x)->paragraph;
         /* First statement in paragraph must be a GO TO */
         if (!l1->flag_first_is_goto) {
             cb_error_x (x, _("'%s' is not an alterable paragraph"),
                     l1->name);
             continue;
         }
         for (aid = l1->alter_gotos; aid; aid = aid->next) {
             if (aid->goto_id == l2->id) {
                 break;
             }
         }
         if (!aid) {
             aid = cobc_parse_malloc (sizeof(struct cb_alter_id));
             aid->next = l1->alter_gotos;
             aid->goto_id = l2->id;
             l1->alter_gotos = aid;
         }
         for (aid = prog->alter_gotos; aid; aid = aid->next) {
             if (aid->goto_id == l1->id) {
                 break;
             }
         }
         if (!aid) {
             aid = cobc_parse_malloc (sizeof(struct cb_alter_id));
             aid->next = prog->alter_gotos;
             aid->goto_id = l1->id;
             prog->alter_gotos = aid;
         }
     }
 
     current_section = save_section;
     current_paragraph = save_paragraph;
     cobc_cs_check = 0;
 
     prog->file_list = cb_list_reverse (prog->file_list);
     prog->exec_list = cb_list_reverse (prog->exec_list);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_program_data ( struct cb_program * prog )

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

 {
     cb_tree         l;
     cb_tree         x;
     cb_tree         assign;
     struct cb_field     *p;
     struct cb_field     *q;
     struct cb_field     *depfld;
     struct cb_file      *f;
     struct cb_report    *rep;
     unsigned char       *c;
     char            buff[COB_MINI_BUFF];
     unsigned int    odo_level;
 
     for (l = current_program->report_list; l; l = CB_CHAIN (l)) {
         /* Set up LINE-COUNTER / PAGE-COUNTER */
         rep = CB_REPORT (CB_VALUE (l));
         snprintf (buff, (size_t)COB_MINI_MAX,
               "LINE-COUNTER %s", rep->cname);
         x = cb_build_field (cb_build_reference (buff));
         CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
         CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
         CB_FIELD (x)->count++;
         cb_validate_field (CB_FIELD (x));
         rep->line_counter = cb_build_field_reference (CB_FIELD (x), NULL);
         CB_FIELD_ADD (current_program->working_storage, CB_FIELD (x));
         snprintf (buff, (size_t)COB_MINI_MAX,
               "PAGE-COUNTER %s", rep->cname);
         x = cb_build_field (cb_build_reference (buff));
         CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT;
         CB_FIELD (x)->values = CB_LIST_INIT (cb_zero);
         CB_FIELD (x)->count++;
         cb_validate_field (CB_FIELD (x));
         rep->page_counter = cb_build_field_reference (CB_FIELD (x), NULL);
         CB_FIELD_ADD (current_program->working_storage, CB_FIELD (x));
     }
 
     for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
         f = CB_FILE (CB_VALUE (l));
         if (!f->flag_finalized) {
             finalize_file (f, NULL);
         }
     }
 
     /* Build undeclared assignment name now */
     if (cb_assign_clause == CB_ASSIGN_MF) {
         for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
             assign = CB_FILE (CB_VALUE (l))->assign;
             if (!assign) {
                 continue;
             }
             if (CB_REFERENCE_P (assign)) {
                 for (x = current_program->file_list; x; x = CB_CHAIN (x)) {
                     if (!strcmp (CB_FILE (CB_VALUE (x))->name,
                          CB_NAME (assign))) {
                         redefinition_error (assign);
                     }
                 }
                 p = check_level_78 (CB_NAME (assign));
                 if (p) {
                     c = (unsigned char *)CB_LITERAL(CB_VALUE(p->values))->data;
                     assign = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen ((char *)c)));
                     CB_FILE (CB_VALUE (l))->assign = assign;
                 }
             }
             if (CB_REFERENCE_P (assign) &&
                 CB_WORD_COUNT (assign) == 0) {
                 if (cb_warn_implicit_define) {
                     cb_warning (_("'%s' will be implicitly defined"), CB_NAME (assign));
                 }
                 x = cb_build_implicit_field (assign, COB_SMALL_BUFF);
                 CB_FIELD (x)->count++;
                 p = current_program->working_storage;
                 if (p) {
                     while (p->sister) {
                         p = p->sister;
                     }
                     p->sister = CB_FIELD (x);
                 } else {
                     current_program->working_storage = CB_FIELD (x);
                 }
             }
             if (CB_REFERENCE_P (assign)) {
                 x = cb_ref (assign);
                 if (CB_FIELD_P (x) && CB_FIELD (x)->level == 88) {
                     cb_error_x (assign, _("ASSIGN data item '%s' invalid"), CB_NAME (assign));
                 }
             }
         }
     }
 
     if (prog->cursor_pos) {
         x = cb_ref (prog->cursor_pos);
         if (x == cb_error_node) {
             prog->cursor_pos = NULL;
         } else if (CB_FIELD(x)->size != 6 && CB_FIELD(x)->size != 4) {
             cb_error_x (prog->cursor_pos, _("'%s' CURSOR is not 4 or 6 characters long"),
                     cb_name (prog->cursor_pos));
             prog->cursor_pos = NULL;
         }
     }
     if (prog->crt_status) {
         x = cb_ref (prog->crt_status);
         if (x == cb_error_node) {
             prog->crt_status = NULL;
         } else if (CB_FIELD(x)->size != 4) {
             cb_error_x (prog->crt_status, _("'%s' CRT STATUS is not 4 characters long"),
                     cb_name (prog->crt_status));
             prog->crt_status = NULL;
         }
     } else {
         l = cb_build_reference ("COB-CRT-STATUS");
         p = CB_FIELD (cb_build_field (l));
         p->usage = CB_USAGE_DISPLAY;
         p->pic = CB_PICTURE (cb_build_picture ("9(4)"));
         cb_validate_field (p);
         p->flag_no_init = 1;
         /* Do not initialize/bump ref count here
         p->values = CB_LIST_INIT (cb_zero);
         p->count++;
         */
         CB_FIELD_ADD (current_program->working_storage, p);
         prog->crt_status = l;
     }
 
     /* Resolve all references so far */
     for (l = cb_list_reverse (prog->reference_list); l; l = CB_CHAIN (l)) {
         cb_ref (CB_VALUE (l));
     }
 
     /* Check ODO items */
     for (l = cb_depend_check; l; l = CB_CHAIN (l)) {
         x = CB_VALUE(l);
         if (x == cb_error_node) {
             continue;
         }
         q = CB_FIELD_PTR (x);
         if (cb_ref (q->depending) != cb_error_node) {
             depfld = CB_FIELD_PTR (q->depending);
         } else {
             depfld = NULL;
         }
         /* The data item that contains a OCCURS DEPENDING clause must be
            the last data item in the group */
         odo_level = 0;
         for (p = q; ; p = p->parent) {
             if (p->depending) odo_level++;
             p->odo_level = odo_level;
             if (!p->parent) {
                 break;
             }
             for (; p->sister; p = p->sister) {
                 if (p->sister == depfld) {
                         cb_error_x (x,
                                 _("'%s' ODO field item invalid here"),
                                 p->sister->name);
                 }
                 if (!p->sister->redefines) {
                     if (!cb_complex_odo) {
                         cb_error_x (x,
                                 _("'%s' cannot have OCCURS DEPENDING"),
                                 cb_name (x));
                         break;
                     }
                     p->flag_odo_relative = 1;
                 }
             }
         }
 
         /* If the field is GLOBAL, then the ODO must also be GLOBAL */
         if (q->flag_is_global && depfld) {
             if (!depfld->flag_is_global) {
                 cb_error_x (x, _("'%s' ODO item must have GLOBAL attribute"),
                     depfld->name);
             }
         }
     }
     cb_depend_check = NULL;
     cb_needs_01 = 0;
 
     for (l = current_program->file_list; l; l = CB_CHAIN (l)) {
         f = CB_FILE (CB_VALUE (l));
         if (CB_VALID_TREE(f->record_depending)) {
             x = f->record_depending;
             if (cb_ref (x) != cb_error_node) {
 #if 0           /* RXWRXW - This breaks old legacy programs */
                 if (CB_REF_OR_FIELD_P(x)) {
                     p = CB_FIELD_PTR (x);
                     switch (p->storage) {
                     case CB_STORAGE_WORKING:
                     case CB_STORAGE_LOCAL:
                     case CB_STORAGE_LINKAGE:
                         break;
                     default:
                         cb_error (_("RECORD DEPENDING item must be in WORKING/LOCAL/LINKAGE section"));
                     }
                 } else {
 #endif
                 if (!CB_REF_OR_FIELD_P(x)) {
                     cb_error (_("Invalid RECORD DEPENDING item"));
                 }
 #if 0           /* RXWRXW */
                 }
 #endif
             }
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

void cb_validate_program_environment ( struct cb_program * prog )

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

 {
     cb_tree         x;
     cb_tree         y;
     cb_tree         l;
     cb_tree         ls;
     struct cb_alphabet_name *ap;
     struct cb_class_name    *cp;
     unsigned char       *data;
     size_t          dupls;
     size_t          unvals;
     size_t          count;
     int         lower;
     int         upper;
     int         size;
     int         n;
     int         i;
     int         lastval;
     int         tableval;
     int         values[256];
     int         charvals[256];
 
     /* Check ALPHABET clauses */
     /* Complicated by difference between code set and collating sequence */
     for (l = current_program->alphabet_name_list; l; l = CB_CHAIN (l)) {
         ap = CB_ALPHABET_NAME (CB_VALUE (l));
 
         /* Native */
         if (ap->alphabet_type == CB_ALPHABET_NATIVE) {
             for (n = 0; n < 256; n++) {
                 ap->values[n] = n;
                 ap->alphachr[n] = n;
             }
             continue;
         }
 
         /* ASCII */
         if (ap->alphabet_type == CB_ALPHABET_ASCII) {
             for (n = 0; n < 256; n++) {
 #ifdef  COB_EBCDIC_MACHINE
                 ap->values[n] = (int)cob_refer_ascii[n];
                 ap->alphachr[n] = (int)cob_refer_ascii[n];
 #else
                 ap->values[n] = n;
                 ap->alphachr[n] = n;
 #endif
             }
             continue;
         }
 
         /* EBCDIC */
         if (ap->alphabet_type == CB_ALPHABET_EBCDIC) {
             for (n = 0; n < 256; n++) {
 #ifdef  COB_EBCDIC_MACHINE
                 ap->values[n] = n;
                 ap->alphachr[n] = n;
 #else
                 ap->values[n] = (int)cob_refer_ebcdic[n];
                 ap->alphachr[n] = (int)cob_refer_ebcdic[n];
 #endif
             }
             continue;
         }
 
         /* Custom alphabet */
         dupls = 0;
         unvals = 0;
         count = 0;
         lastval = 0;
         tableval = 0;
         for (n = 0; n < 256; n++) {
             values[n] = -1;
             charvals[n] = -1;
             ap->values[n] = -1;
             ap->alphachr[n] = -1;
         }
         ap->low_val_char = 0;
         ap->high_val_char = 255;
         for (y = ap->custom_list; y; y = CB_CHAIN (y)) {
             if (count > 255) {
                 unvals = 1;
                 break;
             }
             x = CB_VALUE (y);
             if (CB_PAIR_P (x)) {
                 /* X THRU Y */
                 lower = get_value (CB_PAIR_X (x));
                 upper = get_value (CB_PAIR_Y (x));
                 lastval = upper;
                 if (!count) {
                     ap->low_val_char = lower;
                 }
                 if (lower < 0 || lower > 255) {
                     unvals = 1;
                     continue;
                 }
                 if (upper < 0 || upper > 255) {
                     unvals = 1;
                     continue;
                 }
                 if (lower <= upper) {
                     for (i = lower; i <= upper; i++) {
                         if (values[i] != -1) {
                             dupls = 1;
                         }
                         values[i] = i;
                         charvals[i] = i;
                         ap->alphachr[tableval] = i;
                         ap->values[i] = tableval++;
                         count++;
                     }
                 } else {
                     for (i = lower; i >= upper; i--) {
                         if (values[i] != -1) {
                             dupls = 1;
                         }
                         values[i] = i;
                         charvals[i] = i;
                         ap->alphachr[tableval] = i;
                         ap->values[i] = tableval++;
                         count++;
                     }
                 }
             } else if (CB_LIST_P (x)) {
                 /* X ALSO Y ... */
                 if (!count) {
                     ap->low_val_char = get_value (CB_VALUE (x));
                 }
                 for (ls = x; ls; ls = CB_CHAIN (ls)) {
                     n = get_value (CB_VALUE (ls));
                     if (!CB_CHAIN (ls)) {
                         lastval = n;
                     }
                     if (n < 0 || n > 255) {
                         unvals = 1;
                         continue;
                     }
                     if (values[n] != -1) {
                         dupls = 1;
                     }
                     values[n] = n;
                     ap->values[n] = tableval;
                     if (ls == x) {
                         ap->alphachr[tableval] = n;
                         charvals[n] = n;
                     }
                     count++;
                 }
                 tableval++;
             } else {
                 /* Literal */
                 if (CB_NUMERIC_LITERAL_P (x)) {
                     n = get_value (x);
                     lastval = n;
                     if (!count) {
                         ap->low_val_char = n;
                     }
                     if (n < 0 || n > 255) {
                         unvals = 1;
                         continue;
                     }
                     if (values[n] != -1) {
                         dupls = 1;
                     }
                     values[n] = n;
                     charvals[n] = n;
                     ap->alphachr[tableval] = n;
                     ap->values[n] = tableval++;
                     count++;
                 } else if (CB_LITERAL_P (x)) {
                     size = (int)CB_LITERAL (x)->size;
                     data = CB_LITERAL (x)->data;
                     if (!count) {
                         ap->low_val_char = data[0];
                     }
                     lastval = data[size - 1];
                     for (i = 0; i < size; i++) {
                         n = data[i];
                         if (values[n] != -1) {
                             dupls = 1;
                         }
                         values[n] = n;
                         charvals[n] = n;
                         ap->alphachr[tableval] = n;
                         ap->values[n] = tableval++;
                         count++;
                     }
                 } else {
                     n = get_value (x);
                     lastval = n;
                     if (!count) {
                         ap->low_val_char = n;
                     }
                     if (n < 0 || n > 255) {
                         unvals = 1;
                         continue;
                     }
                     if (values[n] != -1) {
                         dupls = 1;
                     }
                     values[n] = n;
                     charvals[n] = n;
                     ap->alphachr[tableval] = n;
                     ap->values[n] = tableval++;
                     count++;
                 }
             }
         }
         if (dupls || unvals) {
             if (dupls) {
                 cb_error_x (l, _("Duplicate character values in alphabet '%s'"),
                         cb_name (CB_VALUE(l)));
             }
             if (unvals) {
                 cb_error_x (l, _("Invalid character values in alphabet '%s'"),
                         cb_name (CB_VALUE(l)));
             }
             ap->low_val_char = 0;
             ap->high_val_char = 255;
             continue;
         }
         /* Calculate HIGH-VALUE */
         /* If all 256 values have been specified, */
         /* HIGH-VALUE is the last one */
         /* Otherwise if HIGH-VALUE has been specified, find the highest */
         /* value that has not been used */
         if (count == 256) {
             ap->high_val_char = lastval;
         } else if (values[255] != -1) {
             for (n = 254; n >= 0; n--) {
                 if (values[n] == -1) {
                     ap->high_val_char = n;
                     break;
                 }
             }
         }
 
         /* Get rest of code set */
         for (n = tableval; n < 256; ++n) {
             for (i = 0; i < 256; ++i) {
                 if (charvals[i] < 0) {
                     charvals[i] = 0;
                     ap->alphachr[n] = i;
                     break;
                 }
             }
         }
 
         /* Fill in missing characters */
         for (n = 0; n < 256; n++) {
             if (ap->values[n] < 0) {
                 ap->values[n] = tableval++;
             }
         }
     }
 
     /* Reset HIGH/LOW-VALUES */
     cb_low = cb_norm_low;
     cb_high = cb_norm_high;
 
     /* Check and generate SYMBOLIC clauses */
     for (l = current_program->symbolic_char_list; l; l = CB_CHAIN (l)) {
         if (CB_VALUE (l)) {
             y = cb_ref (CB_VALUE (l));
             if (y == cb_error_node) {
                 continue;
             }
             if (!CB_ALPHABET_NAME_P (y)) {
                 cb_error_x (y, _("Invalid ALPHABET name"));
                 continue;
             }
         } else {
             y = NULL;
         }
         cb_build_symbolic_chars (CB_PURPOSE (l), y);
     }
 
     /* Check CLASS clauses */
     for (l = current_program->class_name_list; l; l = CB_CHAIN (l)) {
         dupls = 0;
         memset (values, 0, sizeof(values));
         cp = CB_CLASS_NAME (CB_VALUE (l));
         for (y = cp->list; y; y = CB_CHAIN (y)) {
             x = CB_VALUE (y);
             if (CB_PAIR_P (x)) {
                 /* X THRU Y */
                 lower = get_value (CB_PAIR_X (x));
                 upper = get_value (CB_PAIR_Y (x));
                 for (i = lower; i <= upper; i++) {
                     if (values[i]) {
                         dupls = 1;
                     }
                     values[i] = 1;
                 }
             } else {
                 if (CB_NUMERIC_LITERAL_P (x)) {
                     n = get_value (x);
                     if (values[n]) {
                         dupls = 1;
                     }
                     values[n] = 1;
                 } else if (CB_LITERAL_P (x)) {
                     size = (int)CB_LITERAL (x)->size;
                     data = CB_LITERAL (x)->data;
                     for (i = 0; i < size; i++) {
                         n = data[i];
                         if (values[n]) {
                             dupls = 1;
                         }
                         values[n] = 1;
                     }
                 } else {
                     n = get_value (x);
                     if (values[n]) {
                         dupls = 1;
                     }
                     values[n] = 1;
                 }
             }
         }
         if (dupls) {
             if (!cb_relaxed_syntax_check) {
                 cb_error_x (CB_VALUE(l),
                         _("Duplicate values in class '%s'"),
                         cb_name (CB_VALUE(l)));
             } else {
                 cb_warning_x (CB_VALUE(l),
                         _("Duplicate values in class '%s'"),
                         cb_name (CB_VALUE(l)));
             }
         }
     }
 
     /* Resolve the program collating sequence */
     if (prog->collating_sequence) {
         cb_validate_collating (prog);
     }
 
     /* Resolve the program classification */
     if (prog->classification && prog->classification != cb_int1) {
         x = cb_ref (prog->classification);
         if (!CB_LOCALE_NAME_P (x)) {
             cb_error_x (prog->classification,
                     _("'%s' is not a locale name"),
                     cb_name (prog->classification));
             prog->classification = NULL;
             return;
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static unsigned int check_valid_key	(	const struct cb_file *	cbf,
		const struct cb_field *	f
	)

static

Definition at line 8366 of file typeck.c.

References _, cb_file::alt_key_list, cb_error_node, cb_error_x(), cb_field_founder(), CB_FIELD_PTR, cb_ref(), CB_TREE, COB_ORG_INDEXED, current_statement, f1, cb_alt_key::key, cb_file::key, cb_alt_key::next, cb_field::offset, cb_file::organization, cb_file::record, and cb_field::sister.

Referenced by cb_emit_start().

 {
     cb_tree         kfld;
     struct cb_alt_key   *cbak;
     struct cb_field     *f1;
     struct cb_field     *ff;
 
     if (cbf->organization != COB_ORG_INDEXED) {
         if (CB_FIELD_PTR (cbf->key) != f) {
             cb_error_x (CB_TREE (current_statement),
                     _("Invalid key item"));
             return 1;
         }
         return 0;
     }
 
     ff = cb_field_founder (f);
     for (f1 = cbf->record; f1; f1 = f1->sister) {
         if (f1 == ff) {
             break;
         }
     }
     if (!f1) {
         cb_error_x (CB_TREE (current_statement), _("Invalid key item"));
         return 1;
     }
 
     kfld = cb_ref (cbf->key);
     if (kfld == cb_error_node) {
         return 1;
     }
     if (f->offset == CB_FIELD_PTR (kfld)->offset) {
         return 0;
     }
     for (cbak = cbf->alt_key_list; cbak; cbak = cbak->next) {
         kfld = cb_ref (cbak->key);
         if (kfld == cb_error_node) {
             return 1;
         }
         if (f->offset == CB_FIELD_PTR (kfld)->offset) {
             return 0;
         }
     }
     cb_error_x (CB_TREE (current_statement), _("Invalid key item"));
     return 1;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void cob_put_sign_ebcdic	(	unsigned char *	p,
		const int	sign
	)

static

Definition at line 6959 of file typeck.c.

Referenced by cb_build_move_literal().

 {
     if (sign < 0) {
         switch (*p) {
         case '0':
             *p = (unsigned char)'}';
             return;
         case '1':
             *p = (unsigned char)'J';
             return;
         case '2':
             *p = (unsigned char)'K';
             return;
         case '3':
             *p = (unsigned char)'L';
             return;
         case '4':
             *p = (unsigned char)'M';
             return;
         case '5':
             *p = (unsigned char)'N';
             return;
         case '6':
             *p = (unsigned char)'O';
             return;
         case '7':
             *p = (unsigned char)'P';
             return;
         case '8':
             *p = (unsigned char)'Q';
             return;
         case '9':
             *p = (unsigned char)'R';
             return;
         default:
             /* What to do here */
             *p = (unsigned char)'}';
             return;
         }
     }
     switch (*p) {
     case '0':
         *p = (unsigned char)'{';
         return;
     case '1':
         *p = (unsigned char)'A';
         return;
     case '2':
         *p = (unsigned char)'B';
         return;
     case '3':
         *p = (unsigned char)'C';
         return;
     case '4':
         *p = (unsigned char)'D';
         return;
     case '5':
         *p = (unsigned char)'E';
         return;
     case '6':
         *p = (unsigned char)'F';
         return;
     case '7':
         *p = (unsigned char)'G';
         return;
     case '8':
         *p = (unsigned char)'H';
         return;
     case '9':
         *p = (unsigned char)'I';
         return;
     default:
         /* What to do here */
         *p = (unsigned char)'{';
         return;
     }
 }

Here is the caller graph for this function:

void cobc_init_typeck ( void )

Definition at line 8747 of file typeck.c.

References expr_prio, pvalid_char, and valid_char.

Referenced by main().

 {
     const unsigned char *p;
 
     memset (valid_char, 0, sizeof(valid_char));
     for (p = pvalid_char; *p; ++p) {
         valid_char[*p] = 1;
     }
     memset(expr_prio, 0, sizeof(expr_prio));
     expr_prio['x' & 0xFF] = 0;
     expr_prio['^' & 0xFF] = 1;
     expr_prio['*' & 0xFF] = 2;
     expr_prio['/' & 0xFF] = 2;
     expr_prio['+' & 0xFF] = 3;
     expr_prio['-' & 0xFF] = 3;
     expr_prio['=' & 0xFF] = 4;
     expr_prio['~' & 0xFF] = 4;
     expr_prio['<' & 0xFF] = 4;
     expr_prio['>' & 0xFF] = 4;
     expr_prio['[' & 0xFF] = 4;
     expr_prio[']' & 0xFF] = 4;
     expr_prio['!' & 0xFF] = 5;
     expr_prio['&' & 0xFF] = 6;
     expr_prio['|' & 0xFF] = 7;
     expr_prio[')' & 0xFF] = 8;
     expr_prio['(' & 0xFF] = 9;
     expr_prio[0] = 10;
 }

Here is the caller graph for this function:

static int count_pic_alphanumeric_edited ( struct cb_field * field )

static

Definition at line 6060 of file typeck.c.

References cb_field::count, cb_field::pic, and cb_picture::str.

Referenced by validate_move().

 {
     unsigned char   *p;
     int     count;
     int     repeat;
 
     /* Count number of free places in an alphanumeric edited field */
     count = 0;
     for (p = (unsigned char *)(field->pic->str); *p; p += 5) {
         if (*p == '9' || *p == 'A' || *p == 'X') {
             memcpy ((void *)&repeat, p + 1, sizeof(int));
             count += repeat;
         }
     }
     return count;
 }

Here is the caller graph for this function:

static cb_tree decimal_alloc ( void )

static

Definition at line 3229 of file typeck.c.

References _, cb_build_decimal(), COB_MAX_DEC_STRUCT, COBC_ABORT, cobc_abort_pr(), current_program, current_statement, cb_program::decimal_index, cb_program::decimal_index_max, and cb_statement::name.

Referenced by build_decimal_assign(), cb_build_cond(), and decimal_expand().

 {
     cb_tree x;
 
     x = cb_build_decimal (current_program->decimal_index);
     current_program->decimal_index++;
     if (current_program->decimal_index >= COB_MAX_DEC_STRUCT) {
         cobc_abort_pr (_("Internal decimal structure size exceeded - %d"),
                 COB_MAX_DEC_STRUCT);
         if (strcmp(current_statement->name, "COMPUTE") == 0) {
             cobc_abort_pr (_("Try to minimize the number of parenthesis "
                              "or split into multiple computations."));
         }
         COBC_ABORT ();
     }
     if (current_program->decimal_index > current_program->decimal_index_max) {
         current_program->decimal_index_max = current_program->decimal_index;
     }
     return x;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void decimal_assign	(	cb_tree	x,
		cb_tree	d,
		cb_tree	round_opt
	)

static

Definition at line 3361 of file typeck.c.

References build_store_option(), CB_BUILD_FUNCALL_3, and dpush.

Referenced by build_decimal_assign().

 {
     dpush (CB_BUILD_FUNCALL_3 ("cob_decimal_get_field", d, x,
                    build_store_option (x, round_opt)));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void decimal_compute	(	const int	op,
		cb_tree	x,
		cb_tree	y
	)

static

Definition at line 3257 of file typeck.c.

References _, CB_BUILD_FUNCALL_2, COBC_ABORT, cobc_abort_pr(), and dpush.

Referenced by build_decimal_assign(), and decimal_expand().

 {
     const char *func;
 
     switch (op) {
     case '+':
         func = "cob_decimal_add";
         break;
     case '-':
         func = "cob_decimal_sub";
         break;
     case '*':
         func = "cob_decimal_mul";
         break;
     case '/':
         func = "cob_decimal_div";
         break;
     case '^':
         func = "cob_decimal_pow";
         break;
     default:
         cobc_abort_pr (_("Unexpected operation %d"), op);
         COBC_ABORT ();
     }
     dpush (CB_BUILD_FUNCALL_2 (func, x, y));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void decimal_expand	(	cb_tree	d,
		cb_tree	x
	)

static

Definition at line 3285 of file typeck.c.

References _, CB_BINARY_OP, cb_build_cast_llint(), CB_BUILD_FUNCALL_1, CB_BUILD_FUNCALL_2, CB_BUILD_STRING0, cb_emit, CB_EXCEPTION_ENABLE, CB_FIELD_PTR, cb_int0, CB_LITERAL, CB_TAG_BINARY_OP, CB_TAG_CONST, CB_TAG_INTRINSIC, 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_PACKED, cb_zero, COB_EC_DATA_INCOMPATIBLE, COBC_ABORT, cobc_abort_pr(), decimal_alloc(), decimal_compute(), decimal_free(), dpush, cb_field::name, cb_binary_op::op, cb_field::pic, cb_literal::scale, cb_picture::scale, cb_literal::size, cb_field::size, cb_field::usage, cb_binary_op::x, and cb_binary_op::y.

Referenced by build_decimal_assign(), and cb_build_cond().

 {
     struct cb_literal   *l;
     struct cb_field     *f;
     struct cb_binary_op *p;
     cb_tree         t;
 
     switch (CB_TREE_TAG (x)) {
     case CB_TAG_CONST:
         if (x == cb_zero) {
             dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_llint", d,
                 cb_int0));
         } else {
             cobc_abort_pr (_("Unexpected constant expansion"));
             COBC_ABORT ();
         }
         break;
     case CB_TAG_LITERAL:
         /* Set d, N */
         l = CB_LITERAL (x);
         if (l->size < 19 && l->scale == 0) {
             dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_llint", d,
                 cb_build_cast_llint (x)));
         } else {
             dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_field", d, x));
         }
         break;
     case CB_TAG_REFERENCE:
         /* Set d, X */
         f = CB_FIELD_PTR (x);
         /* Check numeric */
         if (cb_flag_correct_numeric && f->usage == CB_USAGE_DISPLAY) {
             cb_emit (CB_BUILD_FUNCALL_1 ("cob_correct_numeric", x));
         }
         if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE)) {
             if (f->usage == CB_USAGE_DISPLAY ||
                 f->usage == CB_USAGE_PACKED ||
                 f->usage == CB_USAGE_COMP_6) {
                 dpush (CB_BUILD_FUNCALL_2 ("cob_check_numeric",
                                x, CB_BUILD_STRING0 (f->name)));
             }
         }
 
         if ((f->usage == CB_USAGE_BINARY ||
             f->usage == CB_USAGE_COMP_5 ||
             f->usage == CB_USAGE_INDEX ||
             f->usage == CB_USAGE_COMP_X) &&
             !f->pic->scale &&
             (f->size == 1 || f->size == 2 || f->size == 4 ||
              f->size == 8)) {
             dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_llint", d, cb_build_cast_llint (x)));
         } else {
             dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_field", d, x));
         }
         break;
     case CB_TAG_BINARY_OP:
         /* Set d, X
          * Set t, Y
          * OP d, t */
         p = CB_BINARY_OP (x);
         decimal_expand (d, p->x);
         t = decimal_alloc ();
         decimal_expand (t, p->y);
         decimal_compute (p->op, d, t);
         decimal_free ();
         break;
     case CB_TAG_INTRINSIC:
         dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_field", d, x));
         break;
     default:
         cobc_abort_pr (_("Unexpected tree tag %d"), (int)CB_TREE_TAG (x));
         COBC_ABORT ();
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void decimal_free ( void )

static

Definition at line 3251 of file typeck.c.

References current_program, and cb_program::decimal_index.

Referenced by build_decimal_assign(), cb_build_cond(), and decimal_expand().

 {
     current_program->decimal_index--;
 }

Here is the caller graph for this function:

static unsigned int emit_corresponding	(	cb_tree(*)(cb_tree f1, cb_tree f2, cb_tree f3)	func,
		cb_tree	x1,
		cb_tree	x2,
		cb_tree	opt
	)

static

Definition at line 4093 of file typeck.c.

References cb_build_field_reference(), cb_emit, CB_FIELD_PTR, cb_field::children, f1, f2, cb_field::flag_occurs, cb_field::name, cb_field::redefines, and cb_field::sister.

Referenced by cb_emit_corresponding().

 {
     struct cb_field *f1, *f2;
     cb_tree     t1;
     cb_tree     t2;
     unsigned int    found;
 
     found = 0;
     for (f1 = CB_FIELD_PTR (x1)->children; f1; f1 = f1->sister) {
         if (!f1->redefines && !f1->flag_occurs) {
             for (f2 = CB_FIELD_PTR (x2)->children; f2; f2 = f2->sister) {
                 if (!f2->redefines && !f2->flag_occurs) {
                     if (strcmp (f1->name, f2->name) == 0) {
                         t1 = cb_build_field_reference (f1, x1);
                         t2 = cb_build_field_reference (f2, x2);
                         if (f1->children && f2->children) {
                             found += emit_corresponding (func, t1, t2, opt);
                         } else {
                             found++;
                             cb_emit (func (t1, t2, opt));
                         }
                     }
                 }
             }
         }
     }
     return found;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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
	)

static

Definition at line 5202 of file typeck.c.

References CB_BUILD_FUNCALL_8, cb_emit, cb_int(), get_line_and_column_from_pos(), line, and NULL.

Referenced by cb_emit_display().

 {
     cb_tree line = NULL;
     cb_tree column = NULL;
 
     get_line_and_column_from_pos (pos, &line, &column);
     cb_emit (CB_BUILD_FUNCALL_8 ("cob_field_display",
                      x, line, column, fgc, bgc,
                      scroll, size_is,
                      cb_int (dispattrs)));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static unsigned int emit_move_corresponding	(	cb_tree	x1,
		cb_tree	x2
	)

static

Definition at line 4145 of file typeck.c.

References cb_build_field_reference(), cb_build_move(), cb_emit, CB_FIELD_PTR, cb_field::children, f1, f2, cb_field::flag_occurs, cb_field::name, cb_field::redefines, and cb_field::sister.

Referenced by cb_emit_move_corresponding().

 {
     struct cb_field *f1, *f2;
     cb_tree     t1;
     cb_tree     t2;
     unsigned int    found;
 
     found = 0;
     for (f1 = CB_FIELD_PTR (x1)->children; f1; f1 = f1->sister) {
         if (!f1->redefines && !f1->flag_occurs) {
             for (f2 = CB_FIELD_PTR (x2)->children; f2; f2 = f2->sister) {
                 if (!f2->redefines && !f2->flag_occurs) {
                     if (strcmp (f1->name, f2->name) == 0) {
                         t1 = cb_build_field_reference (f1, x1);
                         t2 = cb_build_field_reference (f2, x2);
                         if (f1->children && f2->children) {
                             found += emit_move_corresponding (t1, t2);
                         } else {
                             cb_emit (cb_build_move (t1, t2));
                             found++;
                         }
                     }
                 }
             }
         }
     }
     return found;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void emit_screen_display	(	const cb_tree	x,
		const cb_tree	pos
	)

static

Definition at line 5192 of file typeck.c.

References CB_BUILD_FUNCALL_3, cb_emit, get_line_and_column_from_pos(), line, and NULL.

Referenced by cb_emit_display().

 {
     cb_tree line = NULL;
     cb_tree column = NULL;
 
     get_line_and_column_from_pos (pos, &line, &column);
     cb_emit (CB_BUILD_FUNCALL_3 ("cob_screen_display", x, line, column));
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static cb_tree evaluate_test	(	cb_tree	s,
		cb_tree	o
	)

static

Definition at line 5430 of file typeck.c.

References _, cb_any, cb_build_binary_op(), CB_BUILD_NEGATION, cb_error_x(), cb_false, CB_FIELD, CB_FIELD_P, CB_PAIR_X, CB_PAIR_Y, CB_PURPOSE_INT, CB_REFERENCE, CB_REFERENCE_P, CB_TREE, cb_true, CB_VALUE, current_statement, NULL, and value.

Referenced by build_evaluate().

 {
     cb_tree     x;
     cb_tree     y;
     cb_tree     t;
     int     flag;
 
     /* ANY is always true */
     if (o == cb_any) {
         return cb_true;
     }
 
     /* Object TRUE or FALSE */
     if (o == cb_true) {
         return s;
     }
     if (o == cb_false) {
         return CB_BUILD_NEGATION (s);
     }
 
     flag = CB_PURPOSE_INT (o);
     x = CB_PAIR_X (CB_VALUE (o));
     y = CB_PAIR_Y (CB_VALUE (o));
 
     /* Subject TRUE or FALSE */
     if (s == cb_true) {
         return flag ? CB_BUILD_NEGATION (x) : x;
     }
     if (s == cb_false) {
         return flag ? x : CB_BUILD_NEGATION (x);
     }
 
     /* x THRU y */
     if (y) {
         t = cb_build_binary_op (cb_build_binary_op (x, '[', s),
                     '&',
                     cb_build_binary_op (s, '[', y));
 
         return flag ? CB_BUILD_NEGATION (t) : t;
     }
 
     if (CB_REFERENCE_P(x) && CB_FIELD_P(CB_REFERENCE(x)->value) &&
         CB_FIELD(CB_REFERENCE(x)->value)->level == 88) {
         cb_error_x (CB_TREE (current_statement),
                 _("Invalid use of 88 level in WHEN expression"));
         return NULL;
     }
 
     /* Regular comparison */
     switch (flag) {
     case 0:
         /* Equal comparison */
         return cb_build_binary_op (s, '=', x);
     case 1:
         /* Unequal comparison */
         return cb_build_binary_op (s, '~', x);
     default:
         /* Class and relational conditions */
         return x;
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int expr_chk_cond	(	cb_tree	expr_1,
		cb_tree	expr_2
	)

static

Definition at line 2731 of file typeck.c.

References CB_CAST, CB_CAST_ADDR_OF_ADDR, CB_CAST_ADDRESS, CB_CAST_P, CB_CAST_PROGRAM_POINTER, CB_FIELD_PTR, cb_null, CB_REF_OR_FIELD_P, f1, f2, cb_field::flag_is_pointer, and cb_field::level.

Referenced by expr_reduce().

 {
     struct cb_field     *f1;
     struct cb_field     *f2;
     int         is_ptr_1;
     int         is_ptr_2;
 
     /* 88 level is invalid here */
     /* Likewise combination of pointer and non-pointer */
     is_ptr_1 = 0;
     is_ptr_2 = 0;
     if (CB_REF_OR_FIELD_P (expr_1)) {
         f1 = CB_FIELD_PTR (expr_1);
         if (f1->level == 88) {
             return 1;
         }
         if (f1->flag_is_pointer) {
             is_ptr_1 = 1;
         }
     } else if (CB_CAST_P (expr_1)) {
         switch (CB_CAST (expr_1)->cast_type) {
         case CB_CAST_ADDRESS:
         case CB_CAST_ADDR_OF_ADDR:
         case CB_CAST_PROGRAM_POINTER:
             is_ptr_1 = 1;
             break;
         default:
             break;
         }
     } else if (expr_1 == cb_null) {
         is_ptr_1 = 1;
     }
     if (CB_REF_OR_FIELD_P (expr_2)) {
         f2 = CB_FIELD_PTR (expr_2);
         if (f2->level == 88) {
             return 1;
         }
         if (f2->flag_is_pointer) {
             is_ptr_2 = 1;
         }
     } else if (CB_CAST_P (expr_2)) {
         switch (CB_CAST (expr_2)->cast_type) {
         case CB_CAST_ADDRESS:
         case CB_CAST_ADDR_OF_ADDR:
         case CB_CAST_PROGRAM_POINTER:
             is_ptr_2 = 1;
             break;
         default:
             break;
         }
     } else if (expr_2 == cb_null) {
         is_ptr_2 = 1;
     }
     return is_ptr_1 ^ is_ptr_2;
 }

Here is the caller graph for this function:

static void expr_expand ( cb_tree * x )

static

Definition at line 3088 of file typeck.c.

References CB_BINARY_OP, CB_BINARY_OP_P, cb_binary_op::op, cb_binary_op::x, and cb_binary_op::y.

Referenced by cb_expr_finish().

 {
     struct cb_binary_op *p;
 
 start:
     /* Remove parenthesis */
     if (CB_BINARY_OP_P (*x)) {
         p = CB_BINARY_OP (*x);
         if (p->op == '@') {
             *x = p->x;
             goto start;
         }
         expr_expand (&p->x);
         if (p->y) {
             expr_expand (&p->y);
         }
     }
 }

Here is the caller graph for this function:

static int expr_reduce ( int token )

static

Definition at line 2788 of file typeck.c.

References _, CB_BINARY_OP, CB_BINARY_OP_P, cb_build_binary_op(), CB_BUILD_NEGATION, CB_CLASS_BOOLEAN, cb_error_node, CB_TREE_CLASS, cb_warning(), expr_chk_cond(), expr_index, expr_op, expr_prio, TOKEN, and VALUE.

Referenced by cb_expr_finish(), cb_expr_shift(), cb_expr_shift_class(), and cb_expr_shift_sign().

 {
     /* Example:
      * index: -3  -2  -1   0
      * token: 'x' '*' 'x' '+' ...
      */
 
     int op;
 
     while (expr_prio[TOKEN (-2)] <= expr_prio[token]) {
         /* Reduce the expression depending on the last operator */
         op = TOKEN (-2);
         switch (op) {
         case 'x':
             return 0;
 
         case '+':
         case '-':
         case '*':
         case '/':
         case '^':
             /* Arithmetic operators: 'x' op 'x' */
             if (TOKEN (-1) != 'x' || TOKEN (-3) != 'x') {
                 return -1;
             }
             TOKEN (-3) = 'x';
             VALUE (-3) = cb_build_binary_op (VALUE (-3), op, VALUE (-1));
             expr_index -= 2;
             break;
 
         case '!':
             /* Negation: '!' 'x' */
             if (TOKEN (-1) != 'x') {
                 return -1;
             }
             /* 'x' '=' 'x' '|' '!' 'x' */
             if (expr_lh) {
                 if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) {
                     VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1));
                 }
             }
             TOKEN (-2) = 'x';
             VALUE (-2) = CB_BUILD_NEGATION (VALUE (-1));
             expr_index -= 1;
             break;
 
         case '&':
         case '|':
             /* Logical AND/OR: 'x' op 'x' */
             if (TOKEN (-1) != 'x' || TOKEN (-3) != 'x') {
                 return -1;
             }
             /* 'x' '=' 'x' '|' 'x' */
             if (expr_lh) {
                 if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) {
                     VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1));
                 }
                 if (CB_TREE_CLASS (VALUE (-3)) != CB_CLASS_BOOLEAN) {
                     VALUE (-3) = cb_build_binary_op (expr_lh, expr_op, VALUE (-3));
                 }
             }
             /* Warning for complex expressions without explicit parentheses
                (i.e., "a OR b AND c" or "a AND b OR c") */
             if (cb_warn_parentheses && op == '|') {
                 if ((CB_BINARY_OP_P (VALUE (-3)) &&
                      CB_BINARY_OP (VALUE (-3))->op == '&') ||
                     (CB_BINARY_OP_P (VALUE (-1)) &&
                      CB_BINARY_OP (VALUE (-1))->op == '&')) {
                     cb_warning (_("Suggest parentheses around AND within OR"));
                 }
             }
             TOKEN (-3) = 'x';
             VALUE (-3) = cb_build_binary_op (VALUE (-3), op,
                              VALUE (-1));
             expr_index -= 2;
             break;
 
         case '(':
         case ')':
             return 0;
 
         default:
             /* Relational operators */
             if (TOKEN (-1) != 'x') {
                 return -1;
             }
             switch (TOKEN (-3)) {
             case 'x':
                 /* Simple condition: 'x' op 'x' */
                 if (VALUE (-3) == cb_error_node ||
                     VALUE (-1) == cb_error_node) {
                     VALUE (-3) = cb_error_node;
                 } else {
                     expr_lh = VALUE (-3);
                     if (expr_chk_cond (expr_lh, VALUE (-1))) {
                         VALUE (-3) = cb_error_node;
                         return 1;
                     }
                     expr_op = op;
                     TOKEN (-3) = 'x';
                     if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) {
                         VALUE (-3) = cb_build_binary_op (expr_lh, op, VALUE (-1));
                     } else {
                         VALUE (-3) = VALUE (-1);
                     }
                 }
                 expr_index -= 2;
                 break;
             case '&':
             case '|':
                 /* Complex condition: 'x' '=' 'x' '|' op 'x' */
                 if (VALUE (-1) == cb_error_node) {
                     VALUE (-2) = cb_error_node;
                 } else {
                     expr_op = op;
                     TOKEN (-2) = 'x';
                     if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN && expr_lh) {
                         VALUE (-2) = cb_build_binary_op (expr_lh, op, VALUE (-1));
                     } else {
                         VALUE (-2) = VALUE (-1);
                     }
                 }
                 expr_index -= 1;
                 break;
             default:
                 return -1;
             }
             break;
         }
     }
 
     /* Handle special case "op OR x AND" */
     if (token == '&' && TOKEN (-2) == '|' &&
         CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) {
         TOKEN (-1) = 'x';
         VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1));
     }
 
     return 0;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void get_line_and_column_from_pos	(	const cb_tree	pos,
		cb_tree *const	line,
		cb_tree *const	column
	)

static

Definition at line 5173 of file typeck.c.

References cb_int0, CB_PAIR_P, CB_PAIR_X, CB_PAIR_Y, NULL, and valid_screen_pos().

Referenced by emit_field_display(), and emit_screen_display().

 {
     if (!pos) {
         *line = NULL;
         *column = NULL;
     } else if (CB_PAIR_P (pos)) {
         *line = CB_PAIR_X (pos);
         *column = CB_PAIR_Y (pos);
         if (*line == cb_int0) {
             *line = NULL;
         }
     } else if (valid_screen_pos (pos)) {
         *line = pos;
         *column = NULL;
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int get_value ( cb_tree x )

static

Definition at line 1843 of file typeck.c.

References CB_CLASS_NUMERIC, cb_get_int(), CB_LITERAL, cb_norm_high, cb_norm_low, cb_null, cb_quote, cb_space, CB_TREE_CLASS, and cb_zero.

Referenced by cb_validate_program_environment().

 {
     if (x == cb_space) {
         return ' ';
     } else if (x == cb_zero) {
         return '0';
     } else if (x == cb_quote) {
         return cb_flag_apostrophe ? '\'' : '"';
     } else if (x == cb_norm_low) {
         return 0;
     } else if (x == cb_norm_high) {
         return 255;
     } else if (x == cb_null) {
         return 0;
     } else if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) {
         return cb_get_int (x) - 1;
     }
     return CB_LITERAL (x)->data[0];
 }

Here is the call graph for this function:

Here is the caller graph for this function:

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
	)

static

Definition at line 5152 of file typeck.c.

References cb_attr_struct::bgc, cb_attr_struct::dispattrs, cb_attr_struct::fgc, NULL, cb_attr_struct::scroll, and cb_attr_struct::size_is.

Referenced by cb_emit_display(), and cb_emit_display_omitted().

 {
     if (attr_ptr) {
         *fgc = attr_ptr->fgc;
         *bgc = attr_ptr->bgc;
         *scroll = attr_ptr->scroll;
         *size_is = attr_ptr->size_is;
         *dispattrs = attr_ptr->dispattrs;
     } else {
         *fgc = NULL;
         *bgc = NULL;
         *scroll = NULL;
         *size_is = NULL;
         *dispattrs = 0;
     }
 }

Here is the caller graph for this function:

static COB_INLINE COB_A_INLINE int is_less_than_four_or_is_six ( int x )

static

Definition at line 4246 of file typeck.c.

 {
     return x <= 4 || x == 6;
 }

static COB_INLINE COB_A_INLINE int is_reference_with_value ( cb_tree pos )

static

Definition at line 4252 of file typeck.c.

References CB_REFERENCE, CB_REFERENCE_P, NULL, and value.

Referenced by valid_screen_pos_type().

 {
     return CB_REFERENCE_P (pos)
         && (CB_REFERENCE (pos))->value != NULL;
 
 }

Here is the caller graph for this function:

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
	)

static

Definition at line 6025 of file typeck.c.

References CB_LITERAL_P, cb_warning_x(), cb_tree_common::source_line, suppress_warn, and warning_destination().

Referenced by validate_move().

 {
     cb_tree     loc;
 
     if (suppress_warn) {
         return;
     }
     loc = src->source_line ? src : dst;
     if (value_flag) {
         /* VALUE clause */
         if (CB_LITERAL_P (src)) {
             cb_warning_x (dst, msg);
         } else {
             cb_warning_x (loc, msg);
         }
     } else {
         /* MOVE statement */
         if (flag) {
             if (CB_LITERAL_P (src)) {
                 cb_warning_x (dst, msg);
             } else {
                 cb_warning_x (loc, msg);
             }
             if (src_flag) {
                 warning_destination (src);
             }
             warning_destination (dst);
         }
     }
 
     return;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_screen_from	(	struct cb_field *	p,
		const unsigned int	sisters
	)

static

Definition at line 4199 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_emit, CB_TREE, cb_field::children, COB_SCREEN_TYPE_ATTRIBUTE, COB_SCREEN_TYPE_FIELD, COB_SCREEN_TYPE_GROUP, COB_SCREEN_TYPE_VALUE, cb_field::count, cb_field::screen_from, cb_field::sister, cb_field::size, and cb_field::values.

Referenced by cb_emit_accept(), and cb_emit_display().

 {
     int type;
 
     if (sisters && p->sister) {
         output_screen_from (p->sister, 1U);
     }
     if (p->children) {
         output_screen_from (p->children, 1U);
     }
 
     type = (p->children ? COB_SCREEN_TYPE_GROUP :
         p->values ? COB_SCREEN_TYPE_VALUE :
         (p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE);
     if (type == COB_SCREEN_TYPE_FIELD && p->screen_from) {
         /* Bump reference count */
         p->count++;
         cb_emit (CB_BUILD_FUNCALL_2 ("cob_move", p->screen_from,
                          CB_TREE (p)));
     }
 }

Here is the caller graph for this function:

static void output_screen_to	(	struct cb_field *	p,
		const unsigned int	sisters
	)

static

Definition at line 4222 of file typeck.c.

References CB_BUILD_FUNCALL_2, cb_emit, CB_TREE, cb_field::children, COB_SCREEN_TYPE_ATTRIBUTE, COB_SCREEN_TYPE_FIELD, COB_SCREEN_TYPE_GROUP, COB_SCREEN_TYPE_VALUE, cb_field::count, cb_field::screen_to, cb_field::sister, cb_field::size, and cb_field::values.

Referenced by cb_emit_accept().

 {
     int type;
 
     if (sisters && p->sister) {
         output_screen_to (p->sister, 1U);
     }
     if (p->children) {
         output_screen_to (p->children, 1U);
     }
 
     type = (p->children ? COB_SCREEN_TYPE_GROUP :
         p->values ? COB_SCREEN_TYPE_VALUE :
         (p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE);
     if (type == COB_SCREEN_TYPE_FIELD && p->screen_to) {
         /* Bump reference count */
         p->count++;
         cb_emit (CB_BUILD_FUNCALL_2 ("cob_move", CB_TREE (p), p->screen_to));
     }
 }

Here is the caller graph for this function:

static unsigned int search_set_keys	(	struct cb_field *	f,
		cb_tree	x
	)

static

Definition at line 7852 of file typeck.c.

References _, build_cond_88(), CB_BINARY_OP, cb_error_node, cb_error_x(), CB_FIELD_PTR, CB_REF_OR_FIELD_P, CB_REFERENCE_P, CB_TREE, current_statement, cb_key::key, cb_field::keys, cb_field::nkeys, NULL, cb_binary_op::op, cb_key::ref, cb_key::val, cb_binary_op::x, and cb_binary_op::y.

Referenced by cb_build_search_all().

 {
     struct cb_binary_op *p;
     struct cb_field     *fldx;
     struct cb_field     *fldy;
     int         i;
 
     if (CB_REFERENCE_P (x)) {
         x = build_cond_88 (x);
         if (!x || x == cb_error_node) {
             return 1;
         }
     }
 
     p = CB_BINARY_OP (x);
     switch (p->op) {
     case '&':
         if (search_set_keys (f, p->x)) {
             return 1;
         }
         if (search_set_keys (f, p->y)) {
             return 1;
         }
         break;
     case '=':
         fldx = NULL;
         fldy = NULL;
         /* One of the operands must be a key reference */
         if (CB_REF_OR_FIELD_P (p->x)) {
             fldx = CB_FIELD_PTR (p->x);
         }
         if (CB_REF_OR_FIELD_P (p->y)) {
             fldy = CB_FIELD_PTR (p->y);
         }
         if (!fldx && !fldy) {
             cb_error_x (CB_TREE (current_statement),
                     _("Invalid SEARCH ALL condition"));
             return 1;
         }
 
         for (i = 0; i < f->nkeys; ++i) {
             if (fldx == CB_FIELD_PTR (f->keys[i].key)) {
                 f->keys[i].ref = p->x;
                 f->keys[i].val = p->y;
                 break;
             }
         }
         if (i == f->nkeys) {
             for (i = 0; i < f->nkeys; ++i) {
                 if (fldy == CB_FIELD_PTR (f->keys[i].key)) {
                     f->keys[i].ref = p->y;
                     f->keys[i].val = p->x;
                     break;
                 }
             }
             if (i == f->nkeys) {
                 cb_error_x (CB_TREE (current_statement),
                         _("Invalid SEARCH ALL condition"));
                 return 1;
             }
         }
         break;
     default:
         cb_error_x (CB_TREE (current_statement),
                 _("Invalid SEARCH ALL condition"));
         return 1;
     }
     return 0;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int valid_screen_pos ( cb_tree pos )

static

Definition at line 4289 of file typeck.c.

References _, cb_error(), CB_FIELD, CB_LITERAL, CB_NUMERIC_LITERAL_P, CB_REFERENCE, cb_field::pic, cb_picture::size, cb_field::size, valid_screen_pos_type(), and value.

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

 {
     int size;
 
     /* Find size of pos value, if possible */
     if (CB_NUMERIC_LITERAL_P (pos)) {
         size = (CB_LITERAL (pos))->size;
     } else if (valid_screen_pos_type (pos)) {
         size = (CB_FIELD ((CB_REFERENCE (pos))->value))->pic->size;
     } else {
         cb_error (_("Invalid value in AT clause"));
         return 0;
     }
 
     /* Check if size is valid. If it isn't, display error. */
     if (size == 5) {
         cb_error (_("Value in AT clause may not have 5 digits"));
         return 0;
     } else if (size > 6) {
         cb_error (_("Value in AT clause may not be longer than 6 digits"));
         return 0;
     } else {
         return 1;
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int valid_screen_pos_type ( cb_tree pos )

static

Definition at line 4280 of file typeck.c.

References is_reference_with_value(), value_has_picture_clause(), value_is_numeric_field(), and value_pic_has_no_scale().

Referenced by valid_screen_pos().

 {
     return is_reference_with_value (pos)
         && value_is_numeric_field (pos)
         && value_has_picture_clause (pos)
         && value_pic_has_no_scale (pos);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static int validate_attrs	(	cb_tree	pos,
		cb_tree	fgc,
		cb_tree	bgc,
		cb_tree	scroll,
		cb_tree	size_is
	)

static

Definition at line 5142 of file typeck.c.

References cb_validate_one().

Referenced by cb_emit_display(), and cb_emit_display_omitted().

 {
     return  cb_validate_one (pos)
         || cb_validate_one (fgc)
         || cb_validate_one (bgc)
         || cb_validate_one (scroll)
         || cb_validate_one (size_is);
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static void validate_inspect	(	cb_tree	x,
		cb_tree	y,
		const unsigned int	replconv
	)

static

Definition at line 5714 of file typeck.c.

References _, CB_ALPHABET_NAME_P, cb_error_node, cb_error_x(), CB_FIELD_PTR, cb_get_int(), CB_LITERAL, CB_LITERAL_P, cb_ref(), CB_REF_OR_FIELD_P, CB_REFERENCE, CB_TAG_CONST, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE, CB_TREE_TAG, current_statement, cb_reference::length, and cb_reference::offset.

Referenced by cb_build_converting(), cb_build_replacing_all(), cb_build_replacing_first(), cb_build_replacing_leading(), and cb_build_replacing_trailing().

 {
     cb_tree         l;
     struct cb_reference *r;
     size_t          size1;
     size_t          size2;
     int         offset;
 
     size1 = 0;
     size2 = 0;
     switch (CB_TREE_TAG(x)) {
     case CB_TAG_REFERENCE:
         r = CB_REFERENCE (x);
         l = cb_ref (x);
         if (l == cb_error_node) {
             return;
         }
         if (CB_REF_OR_FIELD_P (l)) {
             size1 = CB_FIELD_PTR (x)->size;
         } else if (CB_ALPHABET_NAME_P (l)) {
             size1 = 256;
         }
         if (size1 && r->offset) {
             if (!CB_LITERAL_P (r->offset)) {
                 return;
             }
             offset = cb_get_int (r->offset);
             if (r->length) {
                 if (!CB_LITERAL_P (r->length)) {
                     return;
                 }
                 size1 = cb_get_int (r->length);
             } else {
                 size1 -= (offset - 1);
             }
         }
         break;
     case CB_TAG_LITERAL:
         size1 = CB_LITERAL(x)->size;
         break;
     case CB_TAG_CONST:
         size1 = 1;
         break;
     default:
         break;
     }
     switch (CB_TREE_TAG(y)) {
     case CB_TAG_REFERENCE:
         r = CB_REFERENCE (y);
         l = cb_ref (y);
         if (l == cb_error_node) {
             return;
         }
         if (CB_REF_OR_FIELD_P (l)) {
             size2 = CB_FIELD_PTR (y)->size;
         } else if (CB_ALPHABET_NAME_P (l)) {
             size2 = 256;
         }
         if (size2 && r->offset) {
             if (!CB_LITERAL_P (r->offset)) {
                 return;
             }
             offset = cb_get_int (r->offset);
             if (r->length) {
                 if (!CB_LITERAL_P (r->length)) {
                     return;
                 }
                 size2 = cb_get_int (r->length);
             } else {
                 size2 -= (offset - 1);
             }
         }
         break;
     case CB_TAG_LITERAL:
         size2 = CB_LITERAL(y)->size;
         break;
     default:
         break;
     }
     if (size1 && size2 && size1 != size2) {
         if (replconv == 1) {
             cb_error_x (CB_TREE (current_statement),
                     _("%s operands differ in size"), "REPLACING");
         } else {
             cb_error_x (CB_TREE (current_statement),
                     _("%s operands differ in size"), "CONVERTING");
         }
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

int validate_move	(	cb_tree	src,
		cb_tree	dst,
		const unsigned int	is_value
	)

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

 {
     struct cb_field     *fdst;
     struct cb_field     *fsrc;
     struct cb_literal   *l;
     unsigned char       *p;
     cb_tree         loc;
     cob_s64_t       val;
     size_t          i;
     size_t          is_numeric_edited;
     int         src_scale_mod;
     int         dst_scale_mod;
     int         dst_size_mod;
     int         size;
     int         most_significant;
     int         least_significant;
 
     loc = src->source_line ? src : dst;
     is_numeric_edited = 0;
     overlapping = 0;
     if (CB_REFERENCE_P (dst)) {
         if (CB_ALPHABET_NAME_P(CB_REFERENCE(dst)->value)) {
             goto invalid;
         }
         if (CB_FILE_P(CB_REFERENCE(dst)->value)) {
             goto invalid;
         }
     }
     if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN) {
         cb_error_x (loc, _("Invalid destination for MOVE"));
         return -1;
     }
 
     if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) {
         if (CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
             return 0;
         } else {
             goto invalid;
         }
     }
 
     fdst = CB_FIELD_PTR (dst);
     switch (CB_TREE_TAG (src)) {
     case CB_TAG_CONST:
         if (src == cb_space) {
             if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
                 (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && !is_value)) {
                 if (!cb_relaxed_syntax_check || is_value) {
                     goto invalid;
                 }
                 cb_warning_x (loc, _("Source is non-numeric - substituting zero"));
             }
         } else if (src == cb_zero) {
             if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC) {
                 goto invalid;
             }
         } else if (src == cb_low || src == cb_high || src == cb_quote) {
             if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC ||
                 CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED) {
                 if (!cb_relaxed_syntax_check || is_value) {
                     goto invalid;
                 }
                 cb_warning_x (loc, _("Source is non-numeric - substituting zero"));
             }
         }
         break;
     case CB_TAG_LITERAL:
         l = CB_LITERAL (src);
         if (CB_TREE_CLASS (src) == CB_CLASS_NUMERIC) {
             /* Numeric literal */
             if (l->all) {
                 goto invalid;
             }
             if (fdst->usage == CB_USAGE_DOUBLE ||
                 fdst->usage == CB_USAGE_FLOAT ||
                 fdst->usage == CB_USAGE_LONG_DOUBLE ||
                 fdst->usage == CB_USAGE_FP_BIN32 ||
                 fdst->usage == CB_USAGE_FP_BIN64 ||
                 fdst->usage == CB_USAGE_FP_BIN128 ||
                 fdst->usage == CB_USAGE_FP_DEC64 ||
                 fdst->usage == CB_USAGE_FP_DEC128) {
                 break;
             }
             most_significant = -999;
             least_significant = 999;
 
             /* Compute the most significant figure place */
             for (i = 0; i < l->size; i++) {
                 if (l->data[i] != '0') {
                     break;
                 }
             }
             if (i != l->size) {
                 most_significant = (int) (l->size - l->scale - i - 1);
             }
 
             /* Compute the least significant figure place */
             for (i = 0; i < l->size; i++) {
                 if (l->data[l->size - i - 1] != '0') {
                     break;
                 }
             }
             if (i != l->size) {
                 least_significant = (int) (-l->scale + i);
             }
 
             /* Value check */
             switch (CB_TREE_CATEGORY (dst)) {
             case CB_CATEGORY_ALPHANUMERIC:
             case CB_CATEGORY_ALPHANUMERIC_EDITED:
                 if (is_value) {
                     goto expect_alphanumeric;
                 }
                 if (l->scale == 0) {
                     goto expect_alphanumeric;
                 }
                 goto non_integer_move;
             case CB_CATEGORY_NUMERIC:
                 if (fdst->pic->scale < 0) {
                     /* Check for PIC 9(n)P(m) */
                     if (least_significant < -fdst->pic->scale) {
                         goto value_mismatch;
                     }
                 } else if (fdst->pic->scale > fdst->pic->size) {
                     /* Check for PIC P(n)9(m) */
                     if (most_significant >= fdst->pic->size - fdst->pic->scale) {
                         goto value_mismatch;
                     }
                 }
                 break;
             case CB_CATEGORY_NUMERIC_EDITED:
                 if (is_value) {
                     goto expect_alphanumeric;
                 }
 
                 /* TODO */
                 break;
             case CB_CATEGORY_ALPHABETIC:
                 if (is_value) {
                     goto expect_alphanumeric;
                 }
                 /* Coming from codegen */
                 if (!suppress_warn) {
                     goto invalid;
                 }
 #if 1   /* RXWRXW - Initialize warn */
                 if (warningopt) {
                     cb_warning_x (loc, _("Numeric move to ALPHABETIC"));
                 }
 #endif
                 break;
             default:
                 if (is_value) {
                     goto expect_alphanumeric;
                 }
                 goto invalid;
             }
 
             /* Sign check */
             if (l->sign != 0 && !fdst->pic->have_sign) {
                 if (is_value) {
                     cb_error_x (loc, _("Data item not signed"));
                     return -1;
                 }
                 if (cb_warn_constant) {
                     cb_warning_x (loc, _("Ignoring sign"));
                 }
             }
 
             /* Size check */
             if (fdst->flag_real_binary ||
                 ((fdst->usage == CB_USAGE_COMP_5 ||
                   fdst->usage == CB_USAGE_COMP_X ||
                   fdst->usage == CB_USAGE_BINARY) &&
                   fdst->pic->scale == 0)) {
                 p = l->data;
                 for (i = 0; i < l->size; i++) {
                     if (l->data[i] != '0') {
                         p = &l->data[i];
                         break;
                     }
                 }
                 i = l->size - i;
                 switch (fdst->size) {
                 case 1:
                     if (i > 18) {
                         goto numlit_overflow;
                     }
                     val = cb_get_long_long (src);
                     if (fdst->pic->have_sign) {
                         if (val < COB_S64_C(-128) ||
                             val > COB_S64_C(127)) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (val > COB_S64_C(255)) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 case 2:
                     if (i > 18) {
                         goto numlit_overflow;
                     }
                     val = cb_get_long_long (src);
                     if (fdst->pic->have_sign) {
                         if (val < COB_S64_C(-32768) ||
                             val > COB_S64_C(32767)) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (val > COB_S64_C(65535)) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 case 3:
                     if (i > 18) {
                         goto numlit_overflow;
                     }
                     val = cb_get_long_long (src);
                     if (fdst->pic->have_sign) {
                         if (val < COB_S64_C(-8388608) ||
                             val > COB_S64_C(8388607)) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (val > COB_S64_C(16777215)) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 case 4:
                     if (i > 18) {
                         goto numlit_overflow;
                     }
                     val = cb_get_long_long (src);
                     if (fdst->pic->have_sign) {
                         if (val < COB_S64_C(-2147483648) ||
                             val > COB_S64_C(2147483647)) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (val > COB_S64_C(4294967295)) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 case 5:
                     if (i > 18) {
                         goto numlit_overflow;
                     }
                     val = cb_get_long_long (src);
                     if (fdst->pic->have_sign) {
                         if (val < COB_S64_C(-549755813888) ||
                             val > COB_S64_C(549755813887)) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (val > COB_S64_C(1099511627775)) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 case 6:
                     if (i > 18) {
                         goto numlit_overflow;
                     }
                     val = cb_get_long_long (src);
                     if (fdst->pic->have_sign) {
                         if (val < COB_S64_C(-140737488355328) ||
                             val > COB_S64_C(140737488355327)) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (val > COB_S64_C(281474976710655)) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 case 7:
                     if (i > 18) {
                         goto numlit_overflow;
                     }
                     val = cb_get_long_long (src);
                     if (fdst->pic->have_sign) {
                         if (val < COB_S64_C(-36028797018963968) ||
                             val > COB_S64_C(36028797018963967)) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (val > COB_S64_C(72057594037927935)) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 default:
                     if (fdst->pic->have_sign) {
                         if (i < 19) {
                             break;
                         }
                         if (i > 19) {
                             goto numlit_overflow;
                         }
                         if (memcmp (p, "9223372036854775807", (size_t)19) > 0) {
                             goto numlit_overflow;
                         }
                     } else {
                         if (i < 20) {
                             break;
                         }
                         if (i > 20) {
                             goto numlit_overflow;
                         }
                         if (memcmp (p, "18446744073709551615", (size_t)20) > 0) {
                             goto numlit_overflow;
                         }
                     }
                     break;
                 }
                 return 0;
             }
             if (least_significant < -fdst->pic->scale) {
                 goto size_overflow;
             }
             if (fdst->pic->scale > 0) {
                 size = fdst->pic->digits - fdst->pic->scale;
             } else {
                 size = fdst->pic->digits;
             }
             if (most_significant >= size) {
                 goto size_overflow;
             }
         } else {
             /* Alphanumeric literal */
 
             /* Value check */
             switch (CB_TREE_CATEGORY (dst)) {
             case CB_CATEGORY_ALPHABETIC:
                 for (i = 0; i < l->size; i++) {
                     if (!isalpha (l->data[i]) &&
                         l->data[i] != ' ') {
                         goto value_mismatch;
                     }
                 }
                 break;
             case CB_CATEGORY_NUMERIC:
                 goto expect_numeric;
             case CB_CATEGORY_NUMERIC_EDITED:
                 if (!is_value) {
                     goto expect_numeric;
                 }
 
                 /* TODO: validate the value */
                 break;
             default:
                 break;
             }
 
             /* Size check */
             size = cb_field_size (dst);
             if (size > 0 && (int)l->size > size) {
                 goto size_overflow;
             }
         }
         break;
     case CB_TAG_FIELD:
     case CB_TAG_REFERENCE:
         if (CB_REFERENCE_P(src) &&
             CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) {
             break;
         }
         if (CB_REFERENCE_P(src) &&
             CB_FILE_P(CB_REFERENCE(src)->value)) {
             goto invalid;
         }
         fsrc = CB_FIELD_PTR (src);
         size = cb_field_size (src);
         if (size < 0) {
             size = fsrc->size;
         }
 
         /* Check basic overlapping */
         overlapping = cb_check_overlapping (src, dst, fsrc, fdst);
 
         /* Non-elementary move */
         if (fsrc->children || fdst->children) {
             if (size > fdst->size) {
                 goto size_overflow_1;
             }
             break;
         }
 
         /* Elementary move */
         switch (CB_TREE_CATEGORY (src)) {
         case CB_CATEGORY_ALPHANUMERIC:
             switch (CB_TREE_CATEGORY (dst)) {
             case CB_CATEGORY_NUMERIC:
             case CB_CATEGORY_NUMERIC_EDITED:
                 if (size > (int)fdst->pic->digits) {
                     goto size_overflow_2;
                 }
                 break;
             case CB_CATEGORY_ALPHANUMERIC_EDITED:
                 if (size > count_pic_alphanumeric_edited (fdst)) {
                     goto size_overflow_1;
                 }
                 break;
             default:
                 if (size > fdst->size) {
                     goto size_overflow_1;
                 }
                 break;
             }
             break;
         case CB_CATEGORY_ALPHABETIC:
         case CB_CATEGORY_ALPHANUMERIC_EDITED:
             switch (CB_TREE_CATEGORY (dst)) {
             case CB_CATEGORY_NUMERIC:
             case CB_CATEGORY_NUMERIC_EDITED:
                 goto invalid;
             case CB_CATEGORY_ALPHANUMERIC_EDITED:
                 if (size > count_pic_alphanumeric_edited(fdst)) {
                     goto size_overflow_1;
                 }
                 break;
             default:
                 if (size > fdst->size) {
                     goto size_overflow_1;
                 }
                 break;
             }
             break;
         case CB_CATEGORY_NUMERIC:
         case CB_CATEGORY_NUMERIC_EDITED:
             switch (CB_TREE_CATEGORY (dst)) {
             case CB_CATEGORY_ALPHABETIC:
                 goto invalid;
             case CB_CATEGORY_ALPHANUMERIC_EDITED:
                 is_numeric_edited = 1;
                 /* Drop through */
             case CB_CATEGORY_ALPHANUMERIC:
                 if (!fsrc->pic) {
                     return -1;
                 }
                 if (is_numeric_edited) {
                     dst_size_mod = count_pic_alphanumeric_edited (fdst);
                 } else {
                     dst_size_mod = fdst->size;
                 }
                 if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC &&
                     fsrc->pic->scale > 0) {
                     goto non_integer_move;
                 }
                 if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC &&
                     (int)fsrc->pic->digits > dst_size_mod) {
                     goto size_overflow_2;
                 }
                 if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC_EDITED &&
                     fsrc->size > dst_size_mod) {
                     goto size_overflow_1;
                 }
                 break;
             default:
                 if (!fsrc->pic) {
                     return -1;
                 }
                 if (!fdst->pic) {
                     return -1;
                 }
                 src_scale_mod = fsrc->pic->scale < 0 ?
                         0 : fsrc->pic->scale;
                 dst_scale_mod = fdst->pic->scale < 0 ?
                         0 : fdst->pic->scale;
                 if (fsrc->pic->digits - src_scale_mod >
                     fdst->pic->digits - dst_scale_mod ||
                     src_scale_mod > dst_scale_mod) {
                     goto size_overflow_2;
                 }
                 break;
             }
             break;
         default:
             cb_error_x (loc, _("Invalid source for MOVE"));
             return -1;
         }
         break;
     case CB_TAG_INTEGER:
     case CB_TAG_BINARY_OP:
     case CB_TAG_INTRINSIC:
     case CB_TAG_FUNCALL:
         /* TODO: check this */
         break;
     default:
         cobc_abort_pr (_("Unexpected tree tag %d"),
                 (int)CB_TREE_TAG (src));
         COBC_ABORT ();
     }
     return 0;
 
 invalid:
     if (is_value) {
         cb_error_x (loc, _("Invalid VALUE clause"));
     } else {
         cb_error_x (loc, _("Invalid MOVE statement"));
     }
     return -1;
 
 numlit_overflow:
     if (is_value) {
         cb_error_x (loc, _("Invalid VALUE clause - literal exceeds data size"));
         return -1;
     }
     if (cb_warn_constant && !suppress_warn) {
         cb_warning_x (loc, _("Numeric literal exceeds data size"));
     }
     return 0;
 
 non_integer_move:
     if (cb_move_noninteger_to_alphanumeric == CB_ERROR) {
         goto invalid;
     }
     if (!suppress_warn) {
         cb_warning_x (loc, _("MOVE of non-integer to alphanumeric"));
     }
     return 0;
 
 expect_numeric:
     move_warning (src, dst, is_value, cb_warn_strict_typing, 0,
             _("Numeric value is expected"));
     return 0;
 
 expect_alphanumeric:
     move_warning (src, dst, is_value, cb_warn_strict_typing, 0,
             _("Alphanumeric value is expected"));
     return 0;
 
 value_mismatch:
     move_warning (src, dst, is_value, cb_warn_constant, 0,
             _("Value does not fit the picture string"));
     return 0;
 
 size_overflow:
     move_warning (src, dst, is_value, cb_warn_constant, 0,
             _("Value size exceeds data size"));
     return 0;
 
 size_overflow_1:
     move_warning (src, dst, is_value, cb_warn_truncate, 1,
             _("Sending field larger than receiving field"));
     return 0;
 
 size_overflow_2:
     move_warning (src, dst, is_value, cb_warn_truncate, 1,
             _("Some digits may be truncated"));
     return 0;
 }

Here is the call graph for this function:

Here is the caller graph for this function:

static COB_INLINE COB_A_INLINE int value_has_picture_clause ( cb_tree pos )

static

Definition at line 4268 of file typeck.c.

References CB_FIELD, CB_REFERENCE, NULL, and value.

Referenced by valid_screen_pos_type().

 {
     return (CB_FIELD ((CB_REFERENCE (pos))->value))->pic != NULL;
 }

Here is the caller graph for this function:

static COB_INLINE COB_A_INLINE int value_is_numeric_field ( cb_tree pos )

static

Definition at line 4260 of file typeck.c.

References CB_CATEGORY_NUMERIC, CB_FIELD_P, CB_REFERENCE, and value.

Referenced by valid_screen_pos_type().

 {
     return CB_FIELD_P ((CB_REFERENCE (pos))->value)
         && (CB_REFERENCE (pos))->value->category == CB_CATEGORY_NUMERIC;
 
 }

Here is the caller graph for this function:

static COB_INLINE COB_A_INLINE int value_pic_has_no_scale ( cb_tree pos )

static

Definition at line 4274 of file typeck.c.

References CB_FIELD, CB_REFERENCE, and value.

Referenced by valid_screen_pos_type().

 {
     return (CB_FIELD ((CB_REFERENCE (pos))->value))->pic->scale == 0;
 }

Here is the caller graph for this function:

static void warning_destination ( cb_tree x )

static

Definition at line 5969 of file typeck.c.

References _, CB_FIELD, cb_name(), CB_REFERENCE, CB_TREE, 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(), cb_warning_x(), cb_field::flag_real_binary, cb_field::name, cb_reference::offset, cb_picture::orig, cb_field::pic, cb_field::size, cb_field::usage, and cb_reference::value.

Referenced by move_warning().

 {
     struct cb_reference *r;
     struct cb_field     *f;
     cb_tree         loc;
 
     r = CB_REFERENCE (x);
     f = CB_FIELD (r->value);
     loc = CB_TREE (f);
 
     if (r->offset) {
         return;
     }
 
     if (!strcmp (f->name, "RETURN-CODE") ||
         !strcmp (f->name, "SORT-RETURN") ||
         !strcmp (f->name, "NUMBER-OF-CALL-PARAMETERS")) {
         cb_warning (_("Internal register '%s' defined as BINARY-LONG"),
                 f->name);
     } else if (f->flag_real_binary) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, f->pic->orig);
     } else if (f->usage == CB_USAGE_FLOAT) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "FLOAT");
     } else if (f->usage == CB_USAGE_DOUBLE) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "DOUBLE");
     } else if (f->usage == CB_USAGE_LONG_DOUBLE) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "FLOAT EXTENDED");
     } else if (f->usage == CB_USAGE_FP_BIN32) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "FLOAT-BINARY-7");
     } else if (f->usage == CB_USAGE_FP_BIN64) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "FLOAT-BINARY-16");
     } else if (f->usage == CB_USAGE_FP_BIN128) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "FLOAT-BINARY-34");
     } else if (f->usage == CB_USAGE_FP_DEC64) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "FLOAT-DECIMAL-16");
     } else if (f->usage == CB_USAGE_FP_DEC128) {
         cb_warning_x (loc, _("'%s' defined here as USAGE %s"),
                   f->name, "FLOAT-DECIMAL-34");
     } else if (f->pic) {
         cb_warning_x (loc, _("'%s' defined here as PIC %s"),
                   cb_name (loc), f->pic->orig);
     } else {
         cb_warning_x (loc, _("'%s' defined here as a group of length %d"),
                   cb_name (loc), f->size);
     }
 }

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

const struct optim_table bin_add_funcs[]

static

Definition at line 343 of file typeck.c.

const struct optim_table bin_compare_funcs[]

static

Definition at line 308 of file typeck.c.

const struct optim_table bin_set_funcs[]

static

Initial value:

= {
    {  ((void*)0) ,         COB_OPTIM_MIN },
    { "cob_setswp_u16", COB_SETSWP_U16 },
    { "cob_setswp_u24", COB_SETSWP_U24 },
    { "cob_setswp_u32", COB_SETSWP_U32 },
    { "cob_setswp_u40", COB_SETSWP_U40 },
    { "cob_setswp_u48", COB_SETSWP_U48 },
    { "cob_setswp_u56", COB_SETSWP_U56 },
    { "cob_setswp_u64", COB_SETSWP_U64 },
    {  ((void*)0) ,         COB_OPTIM_MIN },
    { "cob_setswp_s16", COB_SETSWP_S16 },
    { "cob_setswp_s24", COB_SETSWP_S24 },
    { "cob_setswp_s32", COB_SETSWP_S32 },
    { "cob_setswp_s40", COB_SETSWP_S40 },
    { "cob_setswp_s48", COB_SETSWP_S48 },
    { "cob_setswp_s56", COB_SETSWP_S56 },
    { "cob_setswp_s64", COB_SETSWP_S64 }
}