codegen.c File Reference

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

Include dependency graph for codegen.c:

Go to the source code of this file.

Data Structures
struct	sort_list
struct	system_table
struct	label_list
struct	string_list
struct	attr_list
struct	literal_list
struct	field_list
struct	call_list
struct	base_list

Macros
#define	COB_ALIGN   ""
#define	COB_MAX_SUBSCRIPTS   16
#define	COB_MALLOC_ALIGN   15
#define	COB_INSIDE_SIZE   64
#define	INITIALIZE_NONE   0
#define	INITIALIZE_ONE   1
#define	INITIALIZE_DEFAULT   2
#define	INITIALIZE_COMPOUND   3
#define	CB_NEED_HIGH   (1U << 0)
#define	CB_NEED_LOW   (1U << 1)
#define	CB_NEED_QUOTE   (1U << 2)
#define	CB_NEED_SPACE   (1U << 3)
#define	CB_NEED_ZERO   (1U << 4)
#define	COB_SYSTEM_GEN(x, y, z)   { x, #z },

Functions
static void	output (const char *,...)
static int	lookup_string (const char *p)
static void	lookup_call (const char *p)
static void	lookup_func_call (const char *p)
static struct attr_list *	attr_list_reverse (struct attr_list *p)
static struct string_list *	string_list_reverse (struct string_list *p)
static struct literal_list *	literal_list_reverse (struct literal_list *p)
static int	field_cache_cmp (const void *mp1, const void *mp2)
static int	base_cache_cmp (const void *mp1, const void *mp2)
static void *	list_cache_sort (void *inlist, int(*cmpfunc)(const void *mp1, const void *mp2))
static void	output_newline (void)
static void	output_prefix (void)
static void	output_line (const char *fmt,...)
static void	output_indent (const char *str)
static void	output_string (const unsigned char *s, const int size, const cob_u32_t llit)
static void	output_storage (const char *fmt,...)
static void	output_local (const char *fmt,...)
static struct cb_field *	real_field_founder (const struct cb_field *f)
static struct cb_field *	chk_field_variable_size (struct cb_field *f)
static unsigned int	chk_field_variable_address (struct cb_field *fld)
static void	output_base (struct cb_field *f, const cob_u32_t no_output)
static void	output_data (cb_tree x)
static void	output_size (const cb_tree x)
static int	lookup_attr (const int type, const cob_u32_t digits, const int scale, const cob_u32_t flags, unsigned char *pic, const int lenstr)
static char *	user_func_upper (const char *func)
static void	output_attr (const cb_tree x)
static void	output_field (cb_tree x)
static int	lookup_literal (cb_tree x)
static void	output_integer (cb_tree x)
static void	output_long_integer (cb_tree x)
static void	output_index (cb_tree x)
static void	output_param (cb_tree x, int id)
static void	output_funcall (cb_tree x)
static void	output_func_1 (const char *name, cb_tree x)
static void	output_cond (cb_tree x, const int save_flag)
static void	output_move (cb_tree src, cb_tree dst)
static int	initialize_type (struct cb_initialize *p, struct cb_field *f, const int topfield)
static int	initialize_uniform_char (const struct cb_field *f, const struct cb_initialize *p)
static void	output_figurative (cb_tree x, const struct cb_field *f, const int value, const int init_occurs)
static void	output_initialize_literal (cb_tree x, struct cb_field *f, struct cb_literal *l, const int init_occurs)
static void	output_initialize_fp_bindec (cb_tree x, struct cb_field *f)
static void	output_initialize_fp (cb_tree x, struct cb_field *f)
static void	output_initialize_uniform (cb_tree x, const int c, const int size)
static void	output_initialize_one (struct cb_initialize *p, cb_tree x)
static void	output_initialize_compound (struct cb_initialize *p, cb_tree x)
static void	output_initialize (struct cb_initialize *p)
static void	output_occurs (struct cb_field *p)
static void	output_search_whens (cb_tree table, cb_tree var, cb_tree stmt, cb_tree whens)
static void	output_search_all (cb_tree table, cb_tree stmt, cb_tree cond, cb_tree when)
static void	output_search (struct cb_search *p)
static void	output_call_by_value_args (cb_tree x, cb_tree l)
static void	output_bin_field (const cb_tree x, const cob_u32_t id)
static void	output_call (struct cb_call *p)
static void	output_set_attribute (const struct cb_field *f, int val_on, int val_off)
static void	output_cancel (struct cb_cancel *p)
static void	output_perform_call (struct cb_label *lb, struct cb_label *le)
static void	output_perform_exit (struct cb_label *l)
static void	output_funcall_debug (cb_tree x)
static void	output_cond_debug (cb_tree x)
static void	output_perform_once (struct cb_perform *p)
static void	output_perform_until (struct cb_perform *p, cb_tree l)
static void	output_perform (struct cb_perform *p)
static void	output_file_error (struct cb_file *pfile)
static void	output_goto_1 (cb_tree x)
static void	output_goto (struct cb_goto *p)
static void	output_alter (struct cb_alter *p)
static void	output_ferror_stmt (struct cb_statement *p, const int code)
static void	output_section_info (struct cb_label *lp)
static void	output_trace_info (cb_tree x, struct cb_statement *p)
static void	output_label_info (cb_tree x, struct cb_label *lp)
static void	output_alter_check (struct cb_label *lp)
static void	output_stmt (cb_tree x)
static int	output_file_allocation (struct cb_file *f)
static void	output_file_initialization (struct cb_file *f)
static void	output_screen_definition (struct cb_field *p)
static void	output_screen_init (struct cb_field *p, struct cb_field *previous)
static int	literal_value (cb_tree x)
static void	output_alphabet_name_definition (struct cb_alphabet_name *p)
static void	output_class_name_definition (struct cb_class_name *p)
static void	output_initial_values (struct cb_field *f)
static void	output_error_handler (struct cb_program *prog)
static void	output_module_init (struct cb_program *prog)
static void	output_internal_function (struct cb_program *prog, cb_tree parameter_list)
static void	output_entry_function (struct cb_program *prog, cb_tree entry, cb_tree parameter_list, const int gencode)
static void	output_main_function (struct cb_program *prog)
static void	output_header (FILE *fp, const char *locbuff, const struct cb_program *cp)
void	codegen (struct cb_program *prog, const int nested)

Variables
static struct attr_list *	attr_cache = ((void*)0)
static struct literal_list *	literal_cache = ((void*)0)
static struct field_list *	field_cache = ((void*)0)
static struct field_list *	local_field_cache = ((void*)0)
static struct call_list *	call_cache = ((void*)0)
static struct call_list *	func_call_cache = ((void*)0)
static struct base_list *	base_cache = ((void*)0)
static struct base_list *	globext_cache = ((void*)0)
static struct base_list *	local_base_cache = ((void*)0)
static struct string_list *	string_cache = ((void*)0)
static char *	string_buffer = ((void*)0)
static struct label_list *	label_cache = ((void*)0)
static FILE *	output_target = ((void*)0)
static FILE *	cb_local_file = ((void*)0)
static const char *	excp_current_program_id = ((void*)0)
static const char *	excp_current_section = ((void*)0)
static const char *	excp_current_paragraph = ((void*)0)
static struct cb_program *	current_prog = ((void*)0)
static struct cb_label *	last_section = ((void*)0)
static unsigned char *	litbuff = ((void*)0)
static int	litsize = 0
static unsigned int	needs_exit_prog = 0
static unsigned int	needs_unifunc = 0
static unsigned int	need_save_exception = 0
static unsigned int	gen_nested_tab = 0
static unsigned int	gen_alt_ebcdic = 0
static unsigned int	gen_ebcdic_ascii = 0
static unsigned int	gen_full_ebcdic = 0
static unsigned int	gen_native = 0
static unsigned int	gen_custom = 0
static unsigned int	gen_figurative = 0
static unsigned int	gen_dynamic = 0
static int	param_id = 0
static int	stack_id = 0
static int	string_id
static int	num_cob_fields = 0
static int	non_nested_count = 0
static int	loop_counter = 0
static int	progid = 0
static int	last_line = 0
static cob_u32_t	field_iteration = 0
static int	screenptr = 0
static int	local_mem = 0
static int	working_mem = 0
static int	local_working_mem = 0
static int	output_indent_level = 0
static int	last_segment = 0
static int	gen_if_level = 0
static unsigned int	nolitcast = 0
static unsigned int	inside_check = 0
static unsigned int	inside_stack [64]
static unsigned int	i_counters [16]
static const struct system_table	system_tab []

Macro Definition Documentation

#define CB_NEED_HIGH   (1U << 0)

Definition at line 55 of file codegen.c.

Referenced by codegen(), and output_param().

#define CB_NEED_LOW   (1U << 1)

Definition at line 56 of file codegen.c.

Referenced by codegen(), and output_param().

#define CB_NEED_QUOTE   (1U << 2)

Definition at line 57 of file codegen.c.

Referenced by codegen(), and output_param().

#define CB_NEED_SPACE   (1U << 3)

Definition at line 58 of file codegen.c.

Referenced by codegen(), and output_param().

#define CB_NEED_ZERO   (1U << 4)

Definition at line 59 of file codegen.c.

Referenced by codegen(), and output_param().

#define COB_ALIGN   ""

Definition at line 41 of file codegen.c.

Referenced by codegen().

#define COB_INSIDE_SIZE   64

Definition at line 48 of file codegen.c.

Referenced by codegen(), output_cond(), and output_param().

#define COB_MALLOC_ALIGN   15

Definition at line 46 of file codegen.c.

Referenced by output_internal_function().

#define COB_MAX_SUBSCRIPTS   16

Definition at line 44 of file codegen.c.

Referenced by cb_init_constants(), codegen(), and yyparse().

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

Definition at line 182 of file codegen.c.

#define INITIALIZE_COMPOUND   3

Definition at line 53 of file codegen.c.

Referenced by initialize_type(), and output_initialize().

#define INITIALIZE_DEFAULT   2

Definition at line 52 of file codegen.c.

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

#define INITIALIZE_NONE   0

Definition at line 50 of file codegen.c.

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

#define INITIALIZE_ONE   1

Definition at line 51 of file codegen.c.

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

Function Documentation

static struct attr_list* attr_list_reverse ( struct attr_list *  p )

static

Definition at line 269 of file codegen.c.

References attr_list::next, and NULL.

Referenced by codegen().

{
    struct attr_list    *next;
    struct attr_list    *last;

    last = NULL;
    for (; p; p = next) {
        next = p->next;
        p->next = last;
        last = p;
    }
    return last;
}

Here is the caller graph for this function:

static int base_cache_cmp ( const void *  mp1, const void *  mp2  )

static

Definition at line 327 of file codegen.c.

References base_list::f, and cb_field::id.

Referenced by codegen().

                                                             {
    const struct base_list  *fl1;
    const struct base_list  *fl2;

    fl1 = (const struct base_list *)mp1;
    fl2 = (const struct base_list *)mp2;
    return fl1->f->id - fl2->f->id;
}

Here is the caller graph for this function:

static unsigned int chk_field_variable_address ( struct cb_field *  fld )

static

Definition at line 582 of file codegen.c.

References cb_field::children, chk_field_variable_size(), cb_field::depending, cb_field::flag_vaddr_done, cb_field::parent, cb_field::sister, and cb_field::vaddr.

Referenced by output_base(), and output_param().

{
    struct cb_field     *p;
    struct cb_field     *f;

    if (fld->flag_vaddr_done) {
        return fld->vaddr;
    }
    f = fld;
    for (p = f->parent; p; f = f->parent, p = f->parent) {
        for (p = p->children; p != f; p = p->sister) {
            if (p->depending || chk_field_variable_size (p)) {
                fld->vaddr = 1;
                fld->flag_vaddr_done = 1;
                return 1;
            }
        }
    }
    fld->vaddr = 0;
    fld->flag_vaddr_done = 1;
    return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static struct cb_field* chk_field_variable_size ( struct cb_field *  f )

static

Definition at line 556 of file codegen.c.

References cb_field::children, cb_field::depending, cb_field::flag_vsize_done, NULL, cb_field::sister, and cb_field::vsize.

Referenced by chk_field_variable_address(), output_base(), output_param(), and output_size().

{
    struct cb_field     *p;
    struct cb_field     *fc;

    if (f->flag_vsize_done) {
        return f->vsize;
    }
    for (fc = f->children; fc; fc = fc->sister) {
        if (fc->depending) {
            f->vsize = fc;
            f->flag_vsize_done = 1;
            return fc;
        } else if ((p = chk_field_variable_size (fc)) != NULL) {
            f->vsize = p;
            f->flag_vsize_done = 1;
            return p;
        }
    }
    f->vsize = NULL;
    f->flag_vsize_done = 1;
    return NULL;
}

Here is the caller graph for this function:

void codegen	(	struct cb_program *	prog,
		const int	nested
	)

Definition at line 7448 of file codegen.c.

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

Referenced by codegen(), and process_translate().

{
    cb_tree         l;
    struct attr_list    *j;
    struct literal_list *m;
    struct field_list   *k;
    struct string_list  *stp;
    struct call_list    *clp;
    struct base_list    *blp;
    unsigned char       *s;
    struct nested_list  *nlp;
    struct cb_program   *cp;
#if 0   /* RXWRXW - Const */
    struct cb_literal   *lp;
#endif
    cb_tree         l1;
    cb_tree         l2;
    const char      *prevprog;
    struct tm       *loctime;
    cob_u32_t       inc;
#if 0   /* RXWRXW - Sticky */
    int         save_sticky;
#endif
    int         i;
    int         found;
    enum cb_optim       optidx;
    time_t          sectime;

    /* Clear local program stuff */
    current_prog = prog;
    param_id = 0;
    stack_id = 0;
    num_cob_fields = 0;
    progid = 0;
    loop_counter = 0;
    output_indent_level = 0;
    last_line = 0;
    needs_exit_prog = 0;
    gen_custom = 0;
    gen_nested_tab = 0;
    gen_dynamic = 0;
    gen_if_level = 0;
    local_mem = 0;
    local_working_mem = 0;
    need_save_exception = 0;
    last_segment = 0;
    last_section = NULL;
    call_cache = NULL;
    func_call_cache = NULL;
    label_cache = NULL;
    local_base_cache = NULL;
    local_field_cache = NULL;
    inside_check = 0;
    for (i = 0; i < COB_INSIDE_SIZE; ++i) {
        inside_stack[i] = 0;
    }
    excp_current_program_id = prog->orig_program_id;
    excp_current_section = NULL;
    excp_current_paragraph = NULL;
    memset ((void *)i_counters, 0, sizeof (i_counters));
#if 0   /* RXWRXW - Sticky */
    save_sticky = cb_sticky_linkage;
#endif

    output_target = yyout;
    cb_local_file = current_prog->local_include->local_fp;

    if (!nested) {
        /* First iteration */
        gen_alt_ebcdic = 0;
        gen_ebcdic_ascii = 0;
        gen_full_ebcdic = 0;
        gen_native = 0;
        gen_figurative = 0;
        non_nested_count = 0;
        working_mem = 0;
        attr_cache = NULL;
        base_cache = NULL;
        globext_cache = NULL;
        literal_cache = NULL;
        field_cache = NULL;
        string_cache = NULL;
        string_id = 1;
        if (!string_buffer) {
            string_buffer = cobc_main_malloc ((size_t)COB_MINI_BUFF);
        }

        sectime = time (NULL);
        loctime = localtime (&sectime);
        /* Leap seconds ? */
        if (loctime->tm_sec >= 60) {
            loctime->tm_sec = 59;
        }
        if (loctime) {
            strftime (string_buffer, (size_t)COB_MINI_MAX,
                  "%b %d %Y %H:%M:%S", loctime);
        } else {
            strcpy (string_buffer, _("Unknown"));
        }
        output_header (output_target, string_buffer, NULL);
        output_header (cb_storage_file, string_buffer, NULL);
        for (cp = prog; cp; cp = cp->next_program) {
            output_header (cp->local_include->local_fp,
                    string_buffer, cp);
        }

#ifndef _GNU_SOURCE
#ifdef  _XOPEN_SOURCE_EXTENDED
        output ("#ifndef\t_XOPEN_SOURCE_EXTENDED\n");
        output ("#define\t_XOPEN_SOURCE_EXTENDED 1\n");
        output ("#endif\n");
#endif
#endif
        output ("#include <stdio.h>\n");
        output ("#include <stdlib.h>\n");
        output ("#include <stddef.h>\n");
        output ("#include <string.h>\n");
        output ("#include <math.h>\n");
#ifdef  WORDS_BIGENDIAN
        output ("#define  WORDS_BIGENDIAN 1\n");
#endif
#ifdef  COB_KEYWORD_INLINE
        output ("#define  COB_KEYWORD_INLINE %s\n",
            CB_XSTRINGIFY(COB_KEYWORD_INLINE));
#endif
        output ("#include <libcob.h>\n\n");

        output ("#define  COB_SOURCE_FILE\t\t\"%s\"\n",
            cb_source_file);
        output ("#define  COB_PACKAGE_VERSION\t\t\"%s\"\n",
            PACKAGE_VERSION);
        output ("#define  COB_PATCH_LEVEL\t\t%d\n",
            PATCH_LEVEL);
        /* string_buffer has formatted date from above */
        output ("#define  COB_MODULE_FORMATTED_DATE\t\"%s\"\n",
            string_buffer);
        if (loctime) {
            i = ((loctime->tm_year + 1900) * 10000) +
                ((loctime->tm_mon + 1) * 100) +
                loctime->tm_mday;
            output ("#define  COB_MODULE_DATE\t\t%d\n", i);
            i = (loctime->tm_hour * 10000) +
                (loctime->tm_min * 100) +
                loctime->tm_sec;
            output ("#define  COB_MODULE_TIME\t\t%d\n", i);
        } else {
            output ("#define  COB_MODULE_DATE\t\t0\n");
            output ("#define  COB_MODULE_TIME\t\t0\n");
        }

        output_newline ();
        output ("/* Global variables */\n");
        output ("#include \"%s\"\n\n", cb_storage_file_name);

        output ("/* Function prototypes */\n\n");
        for (cp = prog; cp; cp = cp->next_program) {
            /* Build parameter list */
            for (l = cp->entry_list; l; l = CB_CHAIN (l)) {
                for (l1 = CB_VALUE (l); l1; l1 = CB_CHAIN (l1)) {
                    for (l2 = cp->parameter_list; l2; l2 = CB_CHAIN (l2)) {
                        if (strcasecmp (cb_code_field (CB_VALUE (l1))->name,
                                cb_code_field (CB_VALUE (l2))->name) == 0) {
                            break;
                        }
                    }
                    if (l2 == NULL) {
                        cp->parameter_list = cb_list_add (cp->parameter_list, CB_VALUE (l1));
                    }
                }
            }
            if (cp->flag_main) {
                if (!cp->flag_recursive) {
                    output ("static int\t\t%s ();\n",
                        cp->program_id);
                } else {
                    output ("int\t\t\t%s ();\n",
                        cp->program_id);
                }
            } else {
                for (l = cp->entry_list; l; l = CB_CHAIN (l)) {
                    output_entry_function (cp, l, cp->parameter_list, 0);
                }
            }
            if (cp->prog_type == CB_FUNCTION_TYPE) {
                non_nested_count++;
#if 0   /* RXWRXW USERFUNC */
                output ("static cob_field\t*%s_ (const int, cob_field **",
#else
                output ("static cob_field\t*%s_ (const int",
#endif
                    cp->program_id);
            } else if (!cp->nested_level) {
                non_nested_count++;
                output ("static int\t\t%s_ (const int",
                    cp->program_id);
            } else {
                output ("static int\t\t%s_%d_ (const int",
                    cp->program_id, cp->toplev_count);
            }
#if 0   /* RXWRXW USERFUNC */
            if (!cp->flag_chained && cp->prog_type != CB_FUNCTION_TYPE) {
#else
            if (!cp->flag_chained) {
#endif
                for (l = cp->parameter_list; l; l = CB_CHAIN (l)) {
                    output (", cob_u8_t *");
                    if (cb_sticky_linkage) {
                        output_storage ("static cob_u8_t\t\t\t*cob_parm_%d = NULL;\n",
                                cb_code_field (CB_VALUE (l))->id);
                    }
                }
            }
#if 0   /* RXWRXW - NOINLINE */
            if (cb_flag_stack_check) {
                output (") COB_NOINLINE;\n");
            } else {
#endif
                output (");\n");
#if 0   /* RXWRXW - NOINLINE */
            }
#endif
        }
        output ("\n");
    }

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

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

    /* Functions */
    if (!nested) {
        output ("/* Functions */\n\n");
    }

    if (prog->prog_type == CB_FUNCTION_TYPE) {
        output ("/* FUNCTION-ID '%s' */\n\n", prog->orig_program_id);
    } else {
        output ("/* PROGRAM-ID '%s' */\n\n", prog->orig_program_id);
    }

    for (l = prog->entry_list; l; l = CB_CHAIN (l)) {
        output_entry_function (prog, l, prog->parameter_list, 1);
    }

    output_internal_function (prog, prog->parameter_list);

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

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

    output_target = cb_storage_file;

    /* Program local stuff */

    /* CALL cache */
    if (needs_unifunc || call_cache || func_call_cache) {
        output_local ("\n/* Call pointers */\n");
    }
    if (needs_unifunc) {
        output_local ("cob_call_union\t\tcob_unifunc;\n");
    }
    for (clp = call_cache; clp; clp = clp->next) {
        output_local ("static cob_call_union\tcall_%s;\n",
                  clp->callname);
    }
    for (clp = func_call_cache; clp; clp = clp->next) {
        output_local ("static cob_call_union\tfunc_%s;\n",
                  clp->callname);
    }
    needs_unifunc = 0;

    /* Nested / contained list */
    if (prog->nested_prog_list && gen_nested_tab) {
        /* Generate contained program list */
        output_local ("\n/* Nested call table */\n");
        output_local ("static struct cob_call_struct\tcob_nest_tab[] = {\n");
        nlp = prog->nested_prog_list;
        for (; nlp; nlp = nlp->next) {
            if (nlp->nested_prog == prog) {
#if 0   /* RXWRXW Fix recursive */
                if (!prog->flag_recursive) {
                    continue;
                }
#endif
                output_local ("\t{ \"%s\", { (void *(*)())%s_%d__ }, { NULL } },\n",
                    nlp->nested_prog->orig_program_id,
                    nlp->nested_prog->program_id,
                    nlp->nested_prog->toplev_count);
            } else {
                output_local ("\t{ \"%s\", { (void *(*)())%s_%d__ }, { (void *(*)())%s_%d_ } },\n",
                    nlp->nested_prog->orig_program_id,
                    nlp->nested_prog->program_id,
                    nlp->nested_prog->toplev_count,
                    nlp->nested_prog->program_id,
                    nlp->nested_prog->toplev_count);
            }
        }
        output_local ("\t{ NULL, { NULL }, { NULL } }\n");
        output_local ("};\n");
    }

    /* Local indexes */
    found = 0;
    for (i = 0; i < COB_MAX_SUBSCRIPTS; i++) {
        if (i_counters[i]) {
            if (!found) {
                found = 1;
                output_local ("\n/* Subscripts */\n");
            }
            output_local ("int\t\ti%d;\n", i);
        }
    }

    /* PERFORM TIMES counters */
    if (loop_counter) {
        output_local ("\n/* Loop counters */\n");
        for (i = 0; i < loop_counter; i++) {
            output_local ("cob_s64_t\tn%d = 0;\n", i);
        }
        output_local ("\n");
    }

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

    /* Debugging fields */
    if (prog->flag_debugging) {
        output_local ("\n/* DEBUG runtime switch */\n");
        output_local ("static int\tcob_debugging_mode = 0;\n");
    }
    if (need_save_exception) {
        output_local ("\n/* DEBUG exception code save */\n");
        output_local ("int\t\tsave_exception_code = 0;\n");
    }

    /* LOCAL storage pointer */
    if (prog->local_storage && local_mem) {
        output_local ("\n/* LOCAL storage pointer */\n");
        output_local ("unsigned char\t\t*cob_local_ptr = NULL;\n");
        if (current_prog->flag_global_use) {
            output_local ("static unsigned char\t*cob_local_save = NULL;\n");
        }
    }

    /* Call parameter stack */
    output_local ("\n/* Call parameters */\n");
    if (cb_flag_stack_on_heap || prog->flag_recursive) {
        output_local ("cob_field\t\t**cob_procedure_params;\n");
    } else {
        if (prog->max_call_param) {
            i = prog->max_call_param;
        } else {
            i = 1;
        }
        output_local ("cob_field\t\t*cob_procedure_params[%d];\n", i);
    }

    /* Frame stack */
    output_local ("\n/* Perform frame stack */\n");
    if (cb_perform_osvs && current_prog->prog_type == CB_PROGRAM_TYPE) {
        output_local ("struct cob_frame\t*temp_index;\n");
    }
    if (cb_flag_stack_check) {
        output_local ("struct cob_frame\t*frame_overflow;\n");
    }
    output_local ("struct cob_frame\t*frame_ptr;\n");
    if (cb_flag_stack_on_heap || prog->flag_recursive) {
        output_local ("struct cob_frame\t*frame_stack;\n\n");
    } else {
        output_local ("struct cob_frame\tframe_stack[%d];\n\n",
                  cb_stack_size);
    }

    if (gen_dynamic) {
        output_local ("\n/* Dynamic field FUNCTION-ID pointers */\n");
        for (inc = 0; inc < gen_dynamic; inc++) {
            output_local ("cob_field\t*cob_dyn_%u = NULL;\n",
                      inc);
        }
    }

    if (local_base_cache) {
        output_local ("\n/* Data storage */\n");
        local_base_cache = list_cache_sort (local_base_cache,
                            &base_cache_cmp);
        for (blp = local_base_cache; blp; blp = blp->next) {
            if (blp->f->special_index > 1) {
                output_local ("int              %s%d;",
                        CB_PREFIX_BASE, blp->f->id);
            } else if (blp->f->special_index) {
                output_local ("static int       %s%d;",
                        CB_PREFIX_BASE, blp->f->id);
            } else {
                output_local ("static cob_u8_t  %s%d[%d]%s;",
                        CB_PREFIX_BASE, blp->f->id,
                        blp->f->memory_size, COB_ALIGN);
            }
            output_local ("\t/* %s */\n", blp->f->name);
        }
        output_local ("\n/* End of data storage */\n\n");
    }

    if (local_field_cache) {
        /* Switch to local storage file */
        output_target = current_prog->local_include->local_fp;
        output_local ("\n/* Fields */\n");
        local_field_cache = list_cache_sort (local_field_cache,
                             &field_cache_cmp);
        for (k = local_field_cache; k; k = k->next) {
            output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD,
                k->f->id);
            if (!k->f->flag_local) {
                output_field (k->x);
            } else {
                output ("{");
                output_size (k->x);
                output (", NULL, ");
                output_attr (k->x);
                output ("}");
            }
            if (k->f->flag_filler) {
                output (";\t/* Implicit FILLER */\n");
            } else {
                output (";\t/* %s */\n", k->f->name);
            }
        }
        output_local ("\n/* End of fields */\n\n");
        /* Switch to main storage file */
        output_target = cb_storage_file;
    }

    /* Skip to next nested program */

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

    /* Finalize the main include file */

#if 0   /* RXWRXW - GLOBPTR */
    output_storage ("\n/* Global variable pointer */\n");
    output_storage ("static cob_global\t\t*cob_glob_ptr = NULL;\n");
#endif

    if (!cobc_flag_main && non_nested_count > 1) {
        output_storage ("\n/* Module reference count */\n");
        output_storage ("static unsigned int\t\tcob_reference_count = 0;\n");
    }

    output_storage ("\n/* Module path */\n");
    output_storage ("static const char\t\t*cob_module_path = NULL;\n");

    if (globext_cache) {
        output_storage ("\n/* GLOBAL EXTERNAL pointers */\n");
        globext_cache = list_cache_sort (globext_cache, &base_cache_cmp);
        for (blp = globext_cache; blp; blp = blp->next) {
            output_storage ("static unsigned char\t\t*%s%d = NULL;",
                    CB_PREFIX_BASE, blp->f->id);
            output_storage ("\t/* %s */\n", blp->f->name);
        }
    }

    if (base_cache) {
        output_storage ("\n/* Data storage */\n");
        base_cache = list_cache_sort (base_cache, &base_cache_cmp);
        prevprog = NULL;
        for (blp = base_cache; blp; blp = blp->next) {
            if (blp->curr_prog != prevprog) {
                prevprog = blp->curr_prog;
                output_storage ("\n/* PROGRAM-ID : %s */\n",
                        prevprog);
            }
            if (blp->f->special_index) {
                output_storage ("static int       %s%d;",
                        CB_PREFIX_BASE, blp->f->id);
            } else {
                output_storage ("static cob_u8_t  %s%d[%d]%s;",
                        CB_PREFIX_BASE, blp->f->id,
                        blp->f->memory_size, COB_ALIGN);
            }
            output_storage ("\t/* %s */\n", blp->f->name);
        }
        output_storage ("\n/* End of data storage */\n\n");
    }

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

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

    /* Literals, figuratives, constants */
    if (literal_cache || gen_figurative) {
        output_storage ("\n/* Constants */\n");
        literal_cache = literal_list_reverse (literal_cache);
        for (m = literal_cache; m; m = m->next) {
#if 0   /* RXWRXW - Const */
            output ("static const cob_fld_union %s%d\t= ",
                CB_PREFIX_CONST, m->id);
            output ("{");
            output_size (m->x);
            output (", ");
            lp = CB_LITERAL (m->x);
            if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC) {
                output ("\"%s%s\"", (char *)lp->data,
                    (lp->sign < 0) ? "-" : (lp->sign > 0) ? "+" : "");
            } else {
                output_string (lp->data, (int) lp->size, lp->llit);
            }
            output (", ");
            output_attr (m->x);
            output ("}");
#else
            output ("static const cob_field %s%d\t= ",
                CB_PREFIX_CONST, m->id);
            output_field (m->x);
#endif
            output (";\n");
        }
        if (gen_figurative) {
            output ("\n");
            if (gen_figurative & CB_NEED_LOW) {
                output ("static cob_field cob_all_low\t= ");
                output ("{1, ");
                output ("(cob_u8_ptr)\"\\0\", ");
                output ("&cob_all_attr};\n");
            }
            if (gen_figurative & CB_NEED_HIGH) {
                output ("static cob_field cob_all_high\t= ");
                output ("{1, ");
                output ("(cob_u8_ptr)\"\\xff\", ");
                output ("&cob_all_attr};\n");
            }
            if (gen_figurative & CB_NEED_QUOTE) {
                output ("static cob_field cob_all_quote\t= ");
                output ("{1, ");
                if (cb_flag_apostrophe) {
                    output ("(cob_u8_ptr)\"'\", ");
                } else {
                    output ("(cob_u8_ptr)\"\\\"\", ");
                }
                output ("&cob_all_attr};\n");
            }
            if (gen_figurative & CB_NEED_SPACE) {
                output ("static cob_field cob_all_space\t= ");
                output ("{1, ");
                output ("(cob_u8_ptr)\" \", ");
                output ("&cob_all_attr};\n");
            }
            if (gen_figurative & CB_NEED_ZERO) {
                output ("static cob_field cob_all_zero\t= ");
                output ("{1, ");
                output ("(cob_u8_ptr)\"0\", ");
                output ("&cob_all_attr};\n");
            }
        }
        output ("\n");
    }

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

    /* Strings */
    if (string_cache) {
        output_storage ("\n/* Strings */\n");
        string_cache = string_list_reverse (string_cache);
        for (stp = string_cache; stp; stp = stp->next) {
            output ("static const char %s%d[]\t= \"%s\";\n",
                CB_PREFIX_STRING, stp->id, stp->text);
        }
        output_storage ("\n");
    }

    /* Optimizer output */
    for (optidx = COB_OPTIM_MIN; optidx < COB_OPTIM_MAX; ++optidx) {
        if (optimize_defs[optidx]) {
            cob_gen_optim (optidx);
            output_storage ("\n");
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int field_cache_cmp ( const void *  mp1, const void *  mp2  )

static

Definition at line 313 of file codegen.c.

References field_list::curr_prog, field_list::f, and cb_field::id.

Referenced by codegen().

                                                              {
    const struct field_list *fl1;
    const struct field_list *fl2;
    int         ret;

    fl1 = (const struct field_list *)mp1;
    fl2 = (const struct field_list *)mp2;
    ret = strcasecmp (fl1->curr_prog, fl2->curr_prog);
    if (ret) {
        return ret;
    }
    return fl1->f->id - fl2->f->id;
}

Here is the caller graph for this function:

static int initialize_type ( struct cb_initialize *  p, struct cb_field *  f, const int  topfield  )

static

Definition at line 2251 of file codegen.c.

References _, CB_CATEGORY_ALPHANUMERIC_EDITED, CB_CATEGORY_NATIONAL_EDITED, CB_CATEGORY_NUMERIC_EDITED, CB_CHAIN, CB_PURPOSE_INT, CB_TREE, CB_TREE_CATEGORY, cb_tree_type(), 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_field::children, COB_TYPE_NUMERIC_PACKED, COBC_ABORT, cobc_abort_pr(), cb_field::flag_chained, cb_initialize::flag_default, cb_field::flag_external, cb_field::flag_filler, cb_initialize::flag_init_statement, cb_field::flag_item_78, cb_initialize::flag_no_filler_init, INITIALIZE_COMPOUND, INITIALIZE_DEFAULT, INITIALIZE_NONE, INITIALIZE_ONE, cb_field::redefines, cb_initialize::rep, cb_field::sister, cb_field::usage, cb_initialize::val, and cb_field::values.

Referenced by output_initialize(), and output_initialize_compound().

{
    cb_tree     l;
    int     type;

    if (f->flag_item_78) {
        cobc_abort_pr (_("Unexpected CONSTANT item"));
        COBC_ABORT ();
    }

    if (f->flag_chained) {
        return INITIALIZE_ONE;
    }

    if (f->flag_external && !p->flag_init_statement) {
        return INITIALIZE_NONE;
    }

    if (f->redefines && (!topfield || !p->flag_init_statement)) {
        return INITIALIZE_NONE;
    }

    if (f->flag_filler && p->flag_no_filler_init && !f->children) {
        return INITIALIZE_NONE;
    }

    if (p->val && f->values) {
        return INITIALIZE_ONE;
    }

    if (f->children) {
        type = initialize_type (p, f->children, 0);
        if (type == INITIALIZE_ONE) {
            return INITIALIZE_COMPOUND;
        }
        for (f = f->children->sister; f; f = f->sister) {
            if (type != initialize_type (p, f, 0)) {
                return INITIALIZE_COMPOUND;
            }
        }
        return type;
    } else {
        for (l = p->rep; l; l = CB_CHAIN (l)) {
            if ((int)CB_PURPOSE_INT (l) == (int)CB_TREE_CATEGORY (f)) {
                return INITIALIZE_ONE;
            }
        }
    }

    if (p->flag_default) {
        if (cb_default_byte >= 0 && !p->flag_init_statement) {
            return INITIALIZE_DEFAULT;
        }
        switch (f->usage) {
        case CB_USAGE_FLOAT:
        case CB_USAGE_DOUBLE:
        case CB_USAGE_LONG_DOUBLE:
        case CB_USAGE_FP_BIN32:
        case CB_USAGE_FP_BIN64:
        case CB_USAGE_FP_BIN128:
        case CB_USAGE_FP_DEC64:
        case CB_USAGE_FP_DEC128:
            return INITIALIZE_ONE;
        default:
            break;
        }
        switch (CB_TREE_CATEGORY (f)) {
        case CB_CATEGORY_NUMERIC_EDITED:
        case CB_CATEGORY_ALPHANUMERIC_EDITED:
        case CB_CATEGORY_NATIONAL_EDITED:
            return INITIALIZE_ONE;
        default:
            if (cb_tree_type (CB_TREE (f), f) == COB_TYPE_NUMERIC_PACKED) {
                return INITIALIZE_ONE;
            } else {
                return INITIALIZE_DEFAULT;
            }
        }
    }

    return INITIALIZE_NONE;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int initialize_uniform_char ( const struct cb_field *  f, const struct cb_initialize *  p  )

static

Definition at line 2335 of file codegen.c.

References CB_TREE, cb_tree_type(), cb_field::children, COB_TYPE_ALPHANUMERIC, COB_TYPE_NUMERIC_BINARY, COB_TYPE_NUMERIC_DISPLAY, cb_initialize::flag_init_statement, cb_field::redefines, and cb_field::sister.

Referenced by output_initialize(), and output_initialize_compound().

{
    int c;

    if (f->children) {
        c = initialize_uniform_char (f->children, p);
        for (f = f->children->sister; f; f = f->sister) {
            if (!f->redefines) {
                if (c != initialize_uniform_char (f, p)) {
                    return -1;
                }
            }
        }
        return c;
    } else {
        if (cb_default_byte >= 0 && !p->flag_init_statement) {
            return cb_default_byte;
        }
        switch (cb_tree_type (CB_TREE (f), f)) {
        case COB_TYPE_NUMERIC_BINARY:
            return 0;
        case COB_TYPE_NUMERIC_DISPLAY:
            return '0';
        case COB_TYPE_ALPHANUMERIC:
            return ' ';
        default:
            return -1;
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void* list_cache_sort ( void *  inlist, int(*)(const void *mp1, const void *mp2)  cmpfunc  )

static

Definition at line 340 of file codegen.c.

References sort_list::next, and NULL.

Referenced by codegen().

{
    struct sort_list    *p;
    struct sort_list    *q;
    struct sort_list    *e;
    struct sort_list    *tail;
    struct sort_list    *list;
    size_t          insize;
    size_t          nmerges;
    size_t          psize;
    size_t          qsize;
    size_t          i;

    if (!inlist) {
        return NULL;
    }
    list = (struct sort_list *)inlist;
    insize = 1;
    for (;;) {
        p = list;
        list = NULL;
        tail = NULL;
        nmerges = 0;
        while (p) {
            nmerges++;
            q = p;
            psize = 0;
            for (i = 0; i < insize; i++) {
                psize++;
                q = q->next;
                if (!q) {
                    break;
                }
            }
            qsize = insize;
            while (psize > 0 || (qsize > 0 && q)) {
                if (psize == 0) {
                    e = q;
                    q = q->next;
                    if (qsize) {
                        qsize--;
                    }
                } else if (qsize == 0 || !q) {
                    e = p;
                    p = p->next;
                    if (psize) {
                        psize--;
                    }
                } else if ((*cmpfunc) (p, q) <= 0) {
                    e = p;
                    p = p->next;
                    if (psize) {
                        psize--;
                    }
                } else {
                    e = q;
                    q = q->next;
                    if (qsize) {
                        qsize--;
                    }
                }
                if (tail) {
                    tail->next = e;
                } else {
                    list = e;
                }
                tail = e;
            }
            p = q;
        }
        tail->next = NULL;
        if (nmerges <= 1) {
            return (void *)list;
        }
        insize *= 2;
    }
}

Here is the caller graph for this function:

static struct literal_list* literal_list_reverse ( struct literal_list *  p )

static

Definition at line 299 of file codegen.c.

References literal_list::next, and NULL.

Referenced by codegen().

{
    struct literal_list *next;
    struct literal_list *last;

    last = NULL;
    for (; p; p = next) {
        next = p->next;
        p->next = last;
        last = p;
    }
    return last;
}

Here is the caller graph for this function:

static int literal_value ( cb_tree  x )

static

Definition at line 5489 of file codegen.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 output_class_name_definition().

{
    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;
    } else {
        return CB_LITERAL (x)->data[0];
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int lookup_attr ( const int  type, const cob_u32_t  digits, const int  scale, const cob_u32_t  flags, unsigned char *  pic, const int  lenstr  )

static

Definition at line 880 of file codegen.c.

References attr_cache, cb_attr_id, cobc_parse_malloc(), attr_list::digits, attr_list::flags, attr_list::id, attr_list::lenstr, attr_list::next, attr_list::pic, attr_list::scale, and attr_list::type.

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

{
    struct attr_list *l;

    /* Search attribute cache */
    for (l = attr_cache; l; l = l->next) {
        if (type == l->type &&
            digits == l->digits &&
            scale == l->scale &&
            flags == l->flags &&
            ((pic == l->pic) || (pic && l->pic && lenstr == l->lenstr &&
             memcmp ((char *)pic, (char *)(l->pic), (size_t)lenstr) == 0))) {
            return l->id;
        }
    }

    /* Cache new attribute */

    l = cobc_parse_malloc (sizeof (struct attr_list));
    l->id = cb_attr_id;
    l->type = type;
    l->digits = digits;
    l->scale = scale;
    l->flags = flags;
    l->pic = pic;
    l->lenstr = lenstr;
    l->next = attr_cache;
    attr_cache = l;

    return cb_attr_id++;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void lookup_call ( const char *  p )

static

Definition at line 237 of file codegen.c.

References call_cache, call_list::callname, cobc_parse_malloc(), and call_list::next.

Referenced by output_call().

{
    struct call_list *clp;

    for (clp = call_cache; clp; clp = clp->next) {
        if (strcmp (p, clp->callname) == 0) {
            return;
        }
    }
    clp = cobc_parse_malloc (sizeof (struct call_list));
    clp->callname = p;
    clp->next = call_cache;
    call_cache = clp;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void lookup_func_call ( const char *  p )

static

Definition at line 253 of file codegen.c.

References call_list::callname, cobc_parse_malloc(), func_call_cache, and call_list::next.

Referenced by output_param().

{
    struct call_list *clp;

    for (clp = func_call_cache; clp; clp = clp->next) {
        if (strcmp (p, clp->callname) == 0) {
            return;
        }
    }
    clp = cobc_parse_malloc (sizeof (struct call_list));
    clp->callname = p;
    clp->next = func_call_cache;
    func_call_cache = clp;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int lookup_literal ( cb_tree  x )

static

Definition at line 1059 of file codegen.c.

References cb_literal::all, CB_LITERAL, cb_literal_id, CB_TREE_CLASS, cobc_parse_malloc(), cb_literal::data, literal_list::id, literal_list::literal, literal_cache, literal_list::next, NULL, output_field(), output_target, cb_literal::scale, cb_literal::sign, cb_literal::size, and literal_list::x.

Referenced by output_param().

{

    struct cb_literal   *literal;
    struct literal_list *l;
    FILE            *savetarget;

    literal = CB_LITERAL (x);
    /* Search literal cache */
    for (l = literal_cache; l; l = l->next) {
        if (CB_TREE_CLASS (literal) == CB_TREE_CLASS (l->literal) &&
            literal->size == l->literal->size &&
            literal->all == l->literal->all &&
            literal->sign == l->literal->sign &&
            literal->scale == l->literal->scale &&
            memcmp (literal->data, l->literal->data,
                (size_t)literal->size) == 0) {
            return l->id;
        }
    }

    /* Output new literal */
    savetarget = output_target;
    output_target = NULL;
    output_field (x);

    output_target = savetarget;

    /* Cache it */
    l = cobc_parse_malloc (sizeof (struct literal_list));
    l->id = cb_literal_id;
    l->literal = literal;
    l->x = x;
    l->next = literal_cache;
    literal_cache = l;

    return cb_literal_id++;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int lookup_string ( const char *  p )

static

Definition at line 219 of file codegen.c.

References cobc_parse_malloc(), cobc_parse_strdup(), string_list::id, string_list::next, string_cache, string_id, and string_list::text.

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

{
    struct string_list *stp;

    for (stp = string_cache; stp; stp = stp->next) {
        if (strcmp (p, stp->text) == 0) {
            return stp->id;
        }
    }
    stp = cobc_parse_malloc (sizeof (struct string_list));
    stp->text = cobc_parse_strdup (p);
    stp->id = string_id;
    stp->next = string_cache;
    string_cache = stp;
    return string_id++;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output ( const char *  fmt,   ...  )

static

Definition at line 192 of file codegen.c.

References CB_FIELD, cb_ref(), CB_REFERENCE, CB_REFERENCE_P, likely, unlikely, and value.

Referenced by codegen(), output_attr(), output_base(), output_call(), output_call_by_value_args(), output_cancel(), output_cond(), output_data(), output_entry_function(), output_error_handler(), output_field(), output_figurative(), output_file_initialization(), output_func_1(), output_funcall(), output_goto(), output_index(), output_initialize_fp(), output_initialize_fp_bindec(), output_initialize_literal(), output_initialize_one(), output_initialize_uniform(), output_integer(), output_internal_function(), output_label_info(), output_long_integer(), output_module_init(), output_occurs(), output_param(), output_perform(), output_perform_until(), output_screen_init(), output_search_all(), output_search_whens(), output_size(), output_stmt(), output_string(), and output_trace_info().

{
        if (likely(CB_REFERENCE_P (x))) {
                if (unlikely(!CB_REFERENCE (x)->value)) {
                        return CB_FIELD (cb_ref (x));
                }
                return CB_FIELD (CB_REFERENCE (x)->value);
        }
        return CB_FIELD (x);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_alphabet_name_definition ( struct cb_alphabet_name *  p )

static

Definition at line 5511 of file codegen.c.

References cb_alphabet_name::alphabet_type, CB_ALPHABET_CUSTOM, CB_PREFIX_ATTR, CB_PREFIX_FIELD, CB_PREFIX_SEQUENCE, cb_alphabet_name::cname, COB_TYPE_ALPHANUMERIC, lookup_attr(), NULL, output_local(), and cb_alphabet_name::values.

Referenced by output_internal_function().

{
    int     i;

    if (p->alphabet_type != CB_ALPHABET_CUSTOM) {
        return;
    }

    /* Output the table */
    output_local ("static const unsigned char %s%s[256] = {\n",
              CB_PREFIX_SEQUENCE, p->cname);
    for (i = 0; i < 256; i++) {
        if (i == 255) {
            output_local (" %d", p->values[i]);
        } else {
            output_local (" %d,", p->values[i]);
        }
        if (i % 16 == 15) {
            output_local ("\n");
        }
    }
    output_local ("};\n");
    i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
    output_local ("static cob_field %s%s = { 256, (cob_u8_ptr)%s%s, &%s%d };\n",
        CB_PREFIX_FIELD, p->cname,
        CB_PREFIX_SEQUENCE, p->cname,
        CB_PREFIX_ATTR, i);
    output_local ("\n");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_alter ( struct cb_alter *  p )

static

Definition at line 4460 of file codegen.c.

References cb_program::all_procedure, cb_build_debug(), cb_debug_contents, cb_debug_name, CB_LABEL, CB_PREFIX_LABEL, CB_REFERENCE, cb_label::debug_section, cb_label::flag_debugging_mode, cb_program::flag_gen_debug, cb_label::flag_real_label, cb_label::id, cb_label::name, NULL, output_line(), output_perform_call(), output_stmt(), cb_alter::source, and cb_alter::target.

Referenced by output_stmt().

{
    struct cb_label *l1;
    struct cb_label *l2;

    l1 = CB_LABEL (CB_REFERENCE(p->source)->value);
    l2 = CB_LABEL (CB_REFERENCE(p->target)->value);
    output_line ("label_%s%d = %d;", CB_PREFIX_LABEL, l1->id, l2->id);

    /* Check for debugging on procedure name */
    if (current_prog->flag_gen_debug && l1->flag_real_label &&
        (current_prog->all_procedure || l1->flag_debugging_mode)) {
        output_stmt (cb_build_debug (cb_debug_name,
                         (const char *)l1->name, NULL));
        output_stmt (cb_build_debug (cb_debug_contents,
                         (const char *)l2->name, NULL));
        if (current_prog->all_procedure) {
            output_perform_call (current_prog->all_procedure,
                         current_prog->all_procedure);
        } else if (l1->flag_debugging_mode) {
            output_perform_call (l1->debug_section,
                         l1->debug_section);
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_alter_check ( struct cb_label *  lp )

static

Definition at line 4636 of file codegen.c.

References cb_label::alter_gotos, CB_PREFIX_LABEL, cb_program::flag_segments, cb_alter_id::goto_id, cb_label::id, cb_alter_id::next, output_indent(), output_line(), output_local(), and output_newline().

Referenced by output_stmt().

{
    struct cb_alter_id  *aid;

    output_local ("static int\tlabel_%s%d = 0;\n",
             CB_PREFIX_LABEL, lp->id);
    if (current_prog->flag_segments) {
        output_local ("static int\tsave_label_%s%d = 0;\n",
                 CB_PREFIX_LABEL, lp->id);
    }
    output_newline ();
    output_line ("/* ALTER processing */");
    output_line ("switch (label_%s%d)",
             CB_PREFIX_LABEL, lp->id);
    output_indent ("{");
    for (aid = lp->alter_gotos; aid; aid = aid->next) {
            output_line ("case %d:", aid->goto_id);
            output_line ("goto %s%d;", CB_PREFIX_LABEL, aid->goto_id);
    }
    output_indent ("}");
    output_newline ();
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_attr ( const cb_tree  x )

static

Definition at line 929 of file codegen.c.

References _, cb_literal::all, CB_CLASS_NUMERIC, CB_FIELD, CB_LITERAL, CB_PREFIX_ATTR, CB_REFERENCE, CB_TAG_ALPHABET_NAME, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_CLASS, CB_TREE_TAG, cb_tree_type(), CB_USAGE_BINARY, CB_USAGE_COMP_6, 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, COB_FLAG_BINARY_SWAP, COB_FLAG_BINARY_TRUNC, COB_FLAG_BLANK_ZERO, COB_FLAG_HAVE_SIGN, COB_FLAG_IS_FP, COB_FLAG_IS_POINTER, COB_FLAG_JUSTIFIED, COB_FLAG_NO_SIGN_NIBBLE, COB_FLAG_REAL_BINARY, COB_FLAG_SIGN_LEADING, COB_FLAG_SIGN_SEPARATE, COB_TYPE_ALPHANUMERIC, COB_TYPE_ALPHANUMERIC_ALL, COB_TYPE_GROUP, COB_TYPE_NUMERIC_DISPLAY, cob_u32_t, cob_u8_ptr, COBC_ABORT, cobc_abort_pr(), cb_picture::digits, cb_field::flag_binary_swap, cb_field::flag_blank_zero, cb_field::flag_is_pointer, cb_field::flag_justified, cb_field::flag_real_binary, cb_field::flag_sign_leading, cb_field::flag_sign_separate, cb_picture::have_sign, cb_field::id, cb_picture::lenstr, lookup_attr(), NULL, cb_reference::offset, output(), cb_field::pic, cb_literal::scale, cb_picture::scale, cb_literal::sign, cb_literal::size, cb_picture::str, cb_field::usage, and cb_reference::value.

Referenced by codegen(), output_field(), and output_param().

{
    struct cb_literal   *l;
    struct cb_reference *r;
    struct cb_field     *f;
    int         id;
    int         type;
    cob_u32_t       flags;

    id = 0;
    switch (CB_TREE_TAG (x)) {
    case CB_TAG_LITERAL:
        l = CB_LITERAL (x);
        if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) {
            flags = 0;
            if (l->sign != 0) {
                flags = COB_FLAG_HAVE_SIGN | COB_FLAG_SIGN_SEPARATE;
            }
            id = lookup_attr (COB_TYPE_NUMERIC_DISPLAY,
                      l->size, l->scale, flags, NULL, 0);
        } else {
            if (l->all) {
                id = lookup_attr (COB_TYPE_ALPHANUMERIC_ALL, 0, 0, 0, NULL, 0);
            } else {
                id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
            }
        }
        break;
    case CB_TAG_REFERENCE:
        r = CB_REFERENCE (x);
        f = CB_FIELD (r->value);
        flags = 0;
        if (r->offset) {
            id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
        } else {
            type = cb_tree_type (x, f);
            switch (type) {
            case COB_TYPE_GROUP:
            case COB_TYPE_ALPHANUMERIC:
                if (f->flag_justified) {
                    id = lookup_attr (type, 0, 0, COB_FLAG_JUSTIFIED, NULL, 0);
                } else {
                    id = lookup_attr (type, 0, 0, 0, NULL, 0);
                }
                break;
            default:
                if (f->pic->have_sign) {
                    flags |= COB_FLAG_HAVE_SIGN;
                    if (f->flag_sign_separate) {
                        flags |= COB_FLAG_SIGN_SEPARATE;
                    }
                    if (f->flag_sign_leading) {
                        flags |= COB_FLAG_SIGN_LEADING;
                    }
                }
                if (f->flag_blank_zero) {
                    flags |= COB_FLAG_BLANK_ZERO;
                }
                if (f->flag_justified) {
                    flags |= COB_FLAG_JUSTIFIED;
                }
                if (f->flag_binary_swap) {
                    flags |= COB_FLAG_BINARY_SWAP;
                }
                if (f->flag_real_binary) {
                    flags |= COB_FLAG_REAL_BINARY;
                }
                if (f->flag_is_pointer) {
                    flags |= COB_FLAG_IS_POINTER;
                }
                if (cb_binary_truncate &&
                    f->usage == CB_USAGE_BINARY &&
                    !f->flag_real_binary) {
                    flags |= COB_FLAG_BINARY_TRUNC;
                }

                switch (f->usage) {
                case CB_USAGE_COMP_6:
                    flags |= COB_FLAG_NO_SIGN_NIBBLE;
                    break;
                case CB_USAGE_DOUBLE:
                case CB_USAGE_FLOAT:
                case CB_USAGE_LONG_DOUBLE:
#if 0   /* RXWRXW - Floating ind */
                case CB_USAGE_FP_BIN32:
                case CB_USAGE_FP_BIN64:
                case CB_USAGE_FP_BIN128:
                case CB_USAGE_FP_DEC64:
                case CB_USAGE_FP_DEC128:
#endif
                    flags |= COB_FLAG_IS_FP;
                    break;
                default:
                    break;
                }

                id = lookup_attr (type, f->pic->digits,
                          f->pic->scale, flags,
                          (cob_u8_ptr) f->pic->str,
                          f->pic->lenstr);
                break;
            }
        }
        break;
    case CB_TAG_ALPHABET_NAME:
        id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0);
        break;
    default:
        cobc_abort_pr (_("Unexpected tree tag %d"), (int)CB_TREE_TAG (x));
        COBC_ABORT ();
    }

    output ("&%s%d", CB_PREFIX_ATTR, id);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_base ( struct cb_field *  f, const cob_u32_t  no_output  )

static

Definition at line 606 of file codegen.c.

References _, base_cache, CB_PREFIX_BASE, cb_field::children, chk_field_variable_address(), chk_field_variable_size(), COBC_ABORT, cobc_abort_pr(), cobc_parse_malloc(), base_list::curr_prog, cb_field::depending, excp_current_program_id, base_list::f, cb_field::flag_base, cb_field::flag_external, cb_program::flag_file_global, cb_program::flag_global_use, cb_field::flag_is_global, cb_field::flag_item_78, cb_field::flag_local, cb_field::flag_local_storage, cb_field::id, local_base_cache, cb_field::mem_offset, cb_field::name, base_list::next, cb_field::occurs_max, cb_field::offset, output(), output_integer(), output_local(), cb_field::parent, real_field_founder(), cb_field::sister, cb_field::size, cb_field::special_index, and unlikely.

Referenced by output_data(), output_integer(), output_internal_function(), and output_long_integer().

{
    struct cb_field     *f01;
    struct cb_field     *p;
    struct cb_field     *v;
    struct base_list    *bl;

    if (unlikely(f->flag_item_78)) {
        cobc_abort_pr (_("Unexpected CONSTANT item"));
        COBC_ABORT ();
    }

    f01 = real_field_founder (f);

    /* Base storage */

    if (!f01->flag_base) {
        if (f01->special_index > 1U) {
            bl = cobc_parse_malloc (sizeof (struct base_list));
            bl->f = f01;
            bl->curr_prog = excp_current_program_id;
            bl->next = local_base_cache;
            local_base_cache = bl;
        } else if (!f01->flag_external && !f01->flag_local_storage) {
/* RXWRXW
        if (!f01->flag_external && !f01->flag_local_storage) {
*/
            if (!f01->flag_local || f01->flag_is_global) {
                bl = cobc_parse_malloc (sizeof (struct base_list));
                bl->f = f01;
                bl->curr_prog = excp_current_program_id;
                if (f01->flag_is_global ||
                    current_prog->flag_file_global) {
                    bl->next = base_cache;
                    base_cache = bl;
                } else {
                    bl->next = local_base_cache;
                    local_base_cache = bl;
                }
            } else {
                if (current_prog->flag_global_use) {
                    output_local ("unsigned char\t\t*%s%d = NULL;",
                            CB_PREFIX_BASE, f01->id);
                    output_local ("\t/* %s */\n", f01->name);
                    output_local ("static unsigned char\t*save_%s%d;\n",
                            CB_PREFIX_BASE, f01->id);
                } else {
                    output_local ("unsigned char\t*%s%d = NULL;",
                            CB_PREFIX_BASE, f01->id);
                    output_local ("\t/* %s */\n", f01->name);
                }
            }
        }
        f01->flag_base = 1;
    }
    if (no_output) {
        return;
    }

    if (f01->special_index) {
        output ("(cob_u8_t *)&%s%d", CB_PREFIX_BASE, f01->id);
        return;
    } else if (f01->flag_local_storage) {
        if (f01->mem_offset) {
            output ("cob_local_ptr + %d", f01->mem_offset);
        } else {
            output ("cob_local_ptr");
        }
    } else {
        output ("%s%d", CB_PREFIX_BASE, f01->id);
    }

    if (chk_field_variable_address (f)) {
        for (p = f->parent; p; f = f->parent, p = f->parent) {
            for (p = p->children; p != f; p = p->sister) {
                v = chk_field_variable_size (p);
                if (v) {
                    output (" + %d + ", v->offset - p->offset);
                    if (v->size != 1) {
                        output ("%d * ", v->size);
                    }
                    output_integer (v->depending);
                } else if (p->depending && cb_flag_odoslide) {
                    output (" + ");
                    if (p->size != 1) {
                        output ("%d * ", p->size);
                    }
                    output_integer (p->depending);
                } else {
                    output (" + %d", p->size * p->occurs_max);
                }
            }
        }
    } else if (f->offset > 0) {
        output (" + %d", f->offset);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_bin_field ( const cb_tree  x, const cob_u32_t  id  )

static

Definition at line 3279 of file codegen.c.

References cb_fits_int(), CB_LITERAL, CB_NUMERIC_LITERAL_P, CB_PREFIX_ATTR, COB_FLAG_HAVE_SIGN, COB_FLAG_REAL_BINARY, COB_TYPE_NUMERIC_BINARY, cob_u32_t, lookup_attr(), NULL, output_line(), sign, and cb_field::size.

Referenced by output_call().

{
    int     i;
    cob_u32_t   size;
    cob_u32_t   aflags;
    cob_u32_t   digits;

    if (!CB_NUMERIC_LITERAL_P (x)) {
        return;
    }
    aflags = 0;
    if (cb_fits_int (x)) {
        size = 4;
        aflags = COB_FLAG_HAVE_SIGN;
    } else {
        size = 8;
        if (CB_LITERAL (x)->sign < 0) {
            aflags = COB_FLAG_HAVE_SIGN;
        }
    }
    if (size == 8) {
        digits = 18;
    } else {
        digits = 9;
    }
    aflags |= COB_FLAG_REAL_BINARY;
    i = lookup_attr (COB_TYPE_NUMERIC_BINARY, digits, 0, aflags, NULL, 0);
    output_line ("cob_field\tcontent_fb_%u = { %u, content_%u.data, &%s%d };",
             id, size, id, CB_PREFIX_ATTR, i);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_call ( struct cb_call *  p )

static

Definition at line 3311 of file codegen.c.

References cb_call::args, cb_call::call_returning, CB_BINARY_OP_P, CB_CALL_BY_CONTENT, CB_CALL_BY_REFERENCE, CB_CALL_BY_VALUE, CB_CAST_P, CB_CATEGORY_NUMERIC, CB_CHAIN, CB_CLASS_POINTER, CB_CONV_NO_RET_UPD, CB_CONV_STATIC_LINK, CB_CONV_STDCALL, cb_early_exit_list, cb_encode_program_id(), CB_FIELD, CB_FIELD_P, CB_FILE_P, cb_fits_int(), CB_FMT_LLD_F, CB_FMT_LLU_F, cb_get_int(), cb_get_long_long(), cb_get_u_long_long(), CB_LITERAL, CB_LITERAL_P, cb_null, CB_NUMERIC_LITERAL_P, CB_PURPOSE_INT, cb_ref(), CB_REF_OR_FIELD_P, CB_REFERENCE, CB_REFERENCE_P, cb_program::cb_return_code, cb_static_call_list, CB_TAG_FIELD, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_CATEGORY, CB_TREE_CLASS, CB_TREE_TAG, CB_USAGE_LENGTH, CB_USAGE_PROGRAM_POINTER, CB_VALUE, COB_MAX_FIELD_PARAMS, cob_u32_t, cb_call::convention, cb_literal::data, field_iteration, gen_nested_tab, cb_call::is_system, lookup_call(), cb_call::name, needs_exit_prog, needs_unifunc, nested_list::nested_prog, cb_program::nested_prog_list, cb_text_list::next, nested_list::next, NULL, output(), output_bin_field(), output_call_by_value_args(), output_data(), output_indent(), output_indent_level, output_integer(), output_line(), output_move(), output_newline(), output_param(), output_prefix(), output_size(), output_stmt(), output_string(), cb_program::program_id, sign, cb_call::stmt1, cb_call::stmt2, system_table::syst_call, system_table::syst_name, cb_text_list::text, cb_program::toplev_count, and value.

Referenced by output_stmt().

{
    cb_tree             x;
    cb_tree             l;
    struct cb_literal       *lp;
    struct nested_list      *nlp;
    char                *callp;
    char                *system_call;
    const struct system_table   *psyst;
    const char          *convention;
    struct cb_text_list     *ctl;
    char                *s;
    cob_u32_t           n;
    size_t              retptr;
    size_t              gen_exit_program;
    size_t              dynamic_link;
    size_t              need_brace;
#if 0   /* RXWRXW - Clear params */
    cob_u32_t           parmnum;
#endif

    system_call = NULL;
    retptr = 0;
    gen_exit_program = 0;
    dynamic_link = 1;
    if (p->call_returning && p->call_returning != cb_null &&
        CB_TREE_CLASS(p->call_returning) == CB_CLASS_POINTER) {
        retptr = 1;
    }

#ifdef  _WIN32
    if (p->convention & CB_CONV_STDCALL) {
        convention = "_std";
    } else {
        convention = "";
    }
#else
    convention = "";
#endif

    /* System routine entry points */
    if (p->is_system) {
#if 0   /* RXWRXW - system */
        lp = CB_LITERAL (p->name);
        for (psyst = system_tab; psyst->syst_name; psyst++) {
            if (!strcmp((const char *)lp->data,
                (const char *)psyst->syst_name)) {
                system_call = (char *)psyst->syst_call;
                dynamic_link = 0;
                break;
            }
        }
#else
        n = p->is_system - 1U;
        psyst = &system_tab[n];
        system_call = (char *)psyst->syst_call;
        dynamic_link = 0;
#endif
    }

    if (dynamic_link && CB_LITERAL_P (p->name)) {
        if (cb_flag_static_call || (p->convention & CB_CONV_STATIC_LINK)) {
            dynamic_link = 0;
        }
        lp = CB_LITERAL (p->name);
        for (ctl = cb_static_call_list; ctl; ctl = ctl->next) {
            if (!strcmp((const char *)lp->data, ctl->text)) {
                dynamic_link = 0;
                break;
            }
        }
        for (ctl = cb_early_exit_list; ctl; ctl = ctl->next) {
            if (!strcmp((const char *)lp->data, ctl->text)) {
                gen_exit_program = 1;
                break;
            }
        }
    }
    need_brace = 0;

#ifdef  COB_NON_ALIGNED
    if (dynamic_link && retptr) {
        if (!need_brace) {
            need_brace = 1;
            output_indent ("{");
        }
        output_line ("void *temptr;");
    }
#endif

    if (CB_REFERENCE_P (p->name) &&
        CB_FIELD_P (CB_REFERENCE (p->name)->value) &&
        CB_FIELD (CB_REFERENCE (p->name)->value)->usage == CB_USAGE_PROGRAM_POINTER) {
        dynamic_link = 0;
    }

    /* Set up arguments */
    for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) {
        x = CB_VALUE (l);
        switch (CB_PURPOSE_INT (l)) {
        case CB_CALL_BY_REFERENCE:
            if (CB_NUMERIC_LITERAL_P (x) || CB_BINARY_OP_P (x)) {
                if (!need_brace) {
                    need_brace = 1;
                    output_indent ("{");
                }
                output_line ("cob_content\tcontent_%u;", n);
                output_bin_field (x, n);
            } else if (CB_CAST_P (x)) {
                if (!need_brace) {
                    need_brace = 1;
                    output_indent ("{");
                }
                output_line ("void *ptr_%u;", n);
            }
            break;
        case CB_CALL_BY_CONTENT:
            if (CB_CAST_P (x)) {
                if (!need_brace) {
                    need_brace = 1;
                    output_indent ("{");
                }
                output_line ("void *ptr_%u;", n);
            } else if (CB_TREE_TAG (x) != CB_TAG_INTRINSIC &&
                x != cb_null && !(CB_CAST_P (x))) {
                if (!need_brace) {
                    need_brace = 1;
                    output_indent ("{");
                }
                output_line ("union {");
                output_prefix ();
                output ("\tunsigned char data[");
                if (CB_NUMERIC_LITERAL_P (x) ||
                    CB_BINARY_OP_P (x) || CB_CAST_P(x)) {
                    output ("8");
                } else {
                    if (CB_REF_OR_FIELD_P (x)) {
                        output ("%u", (cob_u32_t)cb_code_field (x)->size);
                    } else {
                        output_size (x);
                    }
                }
                output ("];\n");
                output_line ("\tcob_s64_t     datall;");
                output_line ("\tcob_u64_t     dataull;");
                output_line ("\tint           dataint;");
                output_line ("} content_%u;", n);
                output_bin_field (x, n);
            }
            break;
        default:
            break;
        }
    }

    if (need_brace) {
        output_newline ();
    }

    for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) {
        x = CB_VALUE (l);
        switch (CB_PURPOSE_INT (l)) {
        case CB_CALL_BY_REFERENCE:
            if (CB_NUMERIC_LITERAL_P (x)) {
                output_prefix ();
                if (cb_fits_int (x)) {
                    output ("content_%u.dataint = ", n);
                    output ("%d", cb_get_int (x));
                } else {
                    if (CB_LITERAL (x)->sign >= 0) {
                        output ("content_%u.dataull = ", n);
                        output (CB_FMT_LLU_F,
                            cb_get_u_long_long (x));
                    } else {
                        output ("content_%u.datall = ", n);
                        output (CB_FMT_LLD_F,
                            cb_get_long_long (x));
                    }
                }
                output (";\n");
            } else if (CB_BINARY_OP_P (x)) {
                output_prefix ();
                output ("content_%u.dataint = ", n);
                output_integer (x);
                output (";\n");
            } else if (CB_CAST_P (x)) {
                output_prefix ();
                output ("ptr_%u = ", n);
                output_integer (x);
                output (";\n");
            }
            break;
        case CB_CALL_BY_CONTENT:
            if (CB_CAST_P (x)) {
                output_prefix ();
                output ("ptr_%u = ", n);
                output_integer (x);
                output (";\n");
            } else if (CB_TREE_TAG (x) != CB_TAG_INTRINSIC) {
                if (CB_NUMERIC_LITERAL_P (x)) {
                    output_prefix ();
                    if (cb_fits_int (x)) {
                        output ("content_%u.dataint = ", n);
                        output ("%d", cb_get_int (x));
                    } else {
                        if (CB_LITERAL (x)->sign >= 0) {
                            output ("content_%u.dataull = ", n);
                            output (CB_FMT_LLU_F,
                                cb_get_u_long_long (x));
                        } else {
                            output ("content_%u.datall = ", n);
                            output (CB_FMT_LLD_F,
                                cb_get_long_long (x));
                        }
                    }
                    output (";\n");
                } else if (CB_REF_OR_FIELD_P (x) &&
                       CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC &&
                       cb_code_field (x)->usage == CB_USAGE_LENGTH) {
                    output_prefix ();
                    output ("content_%u.dataint = ", n);
                    output_integer (x);
                    output (";\n");
                } else if (x != cb_null && !(CB_CAST_P (x))) {
                    output_prefix ();
                    output ("memcpy (content_%u.data, ", n);
                    output_data (x);
                    output (", ");
                    output_size (x);
                    output (");\n");
                }
            }
            break;
        default:
            break;
        }
    }

    /* Set up parameter types */
    n = 0;
    for (l = p->args; l; l = CB_CHAIN (l), n++) {
        x = CB_VALUE (l);
        field_iteration = n;
        output_prefix ();
        output ("cob_procedure_params[%u] = ", n);
        switch (CB_TREE_TAG (x)) {
        case CB_TAG_LITERAL:
            if (CB_NUMERIC_LITERAL_P (x) &&
                CB_PURPOSE_INT (l) != CB_CALL_BY_VALUE) {
                output ("&content_fb_%u", n + 1);
                break;
            }
            /* Fall through */
        case CB_TAG_FIELD:
        case CB_TAG_INTRINSIC:
            output_param (x, -1);
            break;
        case CB_TAG_REFERENCE:
            switch (CB_TREE_TAG (CB_REFERENCE(x)->value)) {
            case CB_TAG_LITERAL:
            case CB_TAG_FIELD:
            case CB_TAG_INTRINSIC:
                output_param (x, -1);
                break;
            default:
                output ("NULL");
                break;
            }
            break;
        default:
            output ("NULL");
            break;
        }
        output (";\n");
    }

#if 0   /* RXWRXW - Clear params */
    /* Clear extra parameters */
    if (n > COB_MAX_FIELD_PARAMS - 4) {
        parmnum = COB_MAX_FIELD_PARAMS - n;
    } else {
        parmnum = 4;
    }
    parmnum *= sizeof(cob_field *);
    output_line ("memset (&(cob_procedure_params[%u]), 0, %u);",
             n, parmnum);
#endif

    /* Set number of parameters */
    output_prefix ();
    output ("cob_glob_ptr->cob_call_params = %u;\n", n);

    /* Function name */
    output_prefix ();
    /* Special for program pointers */
    if (CB_REFERENCE_P (p->name) &&
        CB_FIELD_P (CB_REFERENCE (p->name)->value) &&
        CB_FIELD (CB_REFERENCE (p->name)->value)->usage ==
        CB_USAGE_PROGRAM_POINTER) {
        needs_unifunc = 1;
        output ("cob_unifunc.funcvoid = ");
        output_integer (p->name);
        output (";\n");
        output_prefix ();
        if (p->call_returning == cb_null) {
            output ("cob_unifunc.funcnull");
        } else if (retptr) {
#ifdef  COB_NON_ALIGNED
            output ("temptr");
#else
            output_integer (p->call_returning);
#endif
            output (" = cob_unifunc.funcptr");
        } else {
            if (p->convention & CB_CONV_NO_RET_UPD) {
                output ("(void)cob_unifunc.funcint");
            } else {
                output_integer (current_prog->cb_return_code);
                output (" = cob_unifunc.funcint");
            }
        }
    } else if (!dynamic_link) {
        /* Static link */
        if (p->call_returning != cb_null) {
            if (retptr) {
#ifdef  COB_NON_ALIGNED
                output ("temptr");
#else
                output_integer (p->call_returning);
#endif
                output (" = (void *)");
            } else if (!(p->convention & CB_CONV_NO_RET_UPD)) {
                output_integer (current_prog->cb_return_code);
                output (" = ");
            } else {
                output ("(void)");
            }
        }
        if (system_call) {
            output ("%s", system_call);
        } else {
            callp = cb_encode_program_id ((char *)(CB_LITERAL (p->name)->data));
            /* Check contained programs */
            nlp = current_prog->nested_prog_list;
            for (; nlp; nlp = nlp->next) {
                if (!strcmp (callp, nlp->nested_prog->program_id)) {
                    break;
                }
            }
            if (nlp) {
                output ("%s_%d__", callp,
                    nlp->nested_prog->toplev_count);
            } else {
                output ("%s", callp);
            }
        }
    } else {
        /* Dynamic link */
        if (CB_LITERAL_P (p->name)) {
            s = (char *)(CB_LITERAL (p->name)->data);
            callp = cb_encode_program_id (s);
            lookup_call (callp);
            /* Check contained programs */
            nlp = current_prog->nested_prog_list;
            for (; nlp; nlp = nlp->next) {
                if (!strcmp (callp, nlp->nested_prog->program_id)) {
                    break;
                }
            }
            output ("if (unlikely(call_%s.funcvoid == NULL || cob_glob_ptr->cob_physical_cancel)) {\n", callp);
            output_prefix ();
            if (nlp) {
                output ("  call_%s.funcint = %s_%d__;\n",
                    callp, callp,
                    nlp->nested_prog->toplev_count);
            } else {
                output ("  call_%s.funcvoid = ", callp);
                output ("cob_resolve_cobol (");
                output_string ((const unsigned char *)s,
                        (int)strlen (s), 0);
                output (", %d, %d);\n", cb_fold_call, !p->stmt1);
            }
            output_prefix ();
            output ("}\n");
        } else {
            callp = NULL;
            needs_unifunc = 1;
            output ("cob_unifunc.funcvoid = cob_call_field (");
            output_param (p->name, -1);
            if (current_prog->nested_prog_list) {
                gen_nested_tab = 1;
                output (", cob_nest_tab, %d, %d);\n",
                    !p->stmt1, cb_fold_call);
            } else {
                output (", NULL, %d, %d);\n",
                    !p->stmt1, cb_fold_call);
            }
        }
        if (p->stmt1) {
            if (callp) {
                output_line ("if (unlikely(call_%s.funcvoid == NULL))", callp);
            } else {
                output_line ("if (unlikely(cob_unifunc.funcvoid == NULL))");
            }
            output_line ("{");
            output_indent_level += 2;
            output_stmt (p->stmt1);
            output_indent_level -= 2;
            output_line ("}");
            output_line ("else");
            output_indent ("{");
        }
        output_prefix ();
        if (p->call_returning == cb_null) {
            if (callp) {
                output ("call_%s.funcnull%s", callp, convention);
            } else {
                output ("cob_unifunc.funcnull%s", convention);
            }
        } else if (retptr) {
#ifdef  COB_NON_ALIGNED
            output ("temptr");
#else
            output_integer (p->call_returning);
#endif
            if (callp) {
                output (" = call_%s.funcptr%s", callp, convention);
            } else {
                output (" = cob_unifunc.funcptr%s", convention);
            }
        } else {
            if (!(p->convention & CB_CONV_NO_RET_UPD)) {
                output_integer (current_prog->cb_return_code);
                output (" = ");
            } else {
                output ("(void)");
            }
            if (callp) {
                output ("call_%s.funcint%s", callp, convention);
            } else {
                output ("cob_unifunc.funcint%s", convention);
            }
        }
    }

    /* Arguments */
    output (" (");
    for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) {
        x = CB_VALUE (l);
        field_iteration = n - 1U;
        switch (CB_PURPOSE_INT (l)) {
        case CB_CALL_BY_REFERENCE:
            if (CB_NUMERIC_LITERAL_P (x) || CB_BINARY_OP_P (x)) {
                output ("content_%u.data", n);
            } else if (CB_REFERENCE_P (x) && CB_FILE_P (cb_ref (x))) {
                output_param (cb_ref (x), -1);
            } else if (CB_CAST_P (x)) {
                output ("&ptr_%u", n);
            } else {
                output_data (x);
            }
            break;
        case CB_CALL_BY_CONTENT:
            if (CB_TREE_TAG (x) != CB_TAG_INTRINSIC && x != cb_null) {
                if (CB_CAST_P (x)) {
                    output ("&ptr_%u", n);
                } else {
                    output ("content_%u.data", n);
                }
            } else {
                output_data (x);
            }
            break;
        case CB_CALL_BY_VALUE:
            output_call_by_value_args (x, l);
            break;
        default:
            break;
        }
        if (CB_CHAIN (l)) {
            output (", ");
        }
    }

    output (");\n");

    if (p->call_returning && (!(p->convention & CB_CONV_NO_RET_UPD))) {
        if (p->call_returning == cb_null) {
            output_prefix ();
            output_integer (current_prog->cb_return_code);
            output (" = 0;\n");
        } else if (!retptr) {
            output_move (current_prog->cb_return_code,
                     p->call_returning);
#ifdef  COB_NON_ALIGNED
        } else {
            output_prefix ();
            output ("memcpy (");
            output_data (p->call_returning);
            output (", &temptr, %u);\n", (cob_u32_t)sizeof (void *));
#endif
        }
    }
    if (gen_exit_program) {
        needs_exit_prog = 1;
        output_line ("if (unlikely(module->flag_exit_program)) {");
        output_line ("\tmodule->flag_exit_program = 0;");
        output_line ("\tgoto exit_program;");
        output_line ("}");
    }
    if (p->stmt2) {
        output_stmt (p->stmt2);
    }

    if (dynamic_link && p->stmt1) {
        output_indent ("}");
    }

    if (need_brace) {
        output_indent ("}");
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_call_by_value_args ( cb_tree  x, cb_tree  l  )

static

Definition at line 3046 of file codegen.c.

References _, CB_CATEGORY_NUMERIC, CB_CLASS_NUMERIC, CB_FMT_LLD_F, CB_FMT_LLU_F, cb_get_long_long(), cb_get_u_long_long(), CB_INTRINSIC, CB_LITERAL, CB_SIZE_1, CB_SIZE_2, CB_SIZE_4, CB_SIZE_8, CB_SIZE_AUTO, CB_SIZES_INT, CB_SIZES_INT_UNSIGNED, CB_TAG_CAST, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TREE_CLASS, CB_TREE_TAG, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_6, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_DOUBLE, CB_USAGE_FLOAT, CB_USAGE_FP_BIN128, CB_USAGE_FP_BIN32, CB_USAGE_FP_BIN64, CB_USAGE_FP_DEC128, CB_USAGE_FP_DEC64, CB_USAGE_INDEX, CB_USAGE_LENGTH, CB_USAGE_LONG_DOUBLE, CB_USAGE_PACKED, CB_USAGE_POINTER, CB_USAGE_PROGRAM_POINTER, cob_s64_t, cob_u64_t, COBC_ABORT, cobc_abort_pr(), cb_picture::digits, cb_picture::have_sign, output(), output_data(), output_integer(), output_param(), cb_field::pic, cb_picture::scale, sign, cb_field::size, and cb_field::usage.

Referenced by output_call().

{
    struct cb_field *f;
    const char  *s;
    cob_s64_t   val;
    cob_u64_t   uval;
    int     sizes;
    int     sign;

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_CAST:
        output_integer (x);
        return;
    case CB_TAG_INTRINSIC:
        if (CB_INTRINSIC(x)->intr_tab->category == CB_CATEGORY_NUMERIC) {
            output ("cob_get_int (");
            output_param (x, -1);
            output (")");
        } else {
            output_data (x);
        }
        return;
    case CB_TAG_LITERAL:
        if (CB_TREE_CLASS (x) != CB_CLASS_NUMERIC) {
            output ("%d", CB_LITERAL (x)->data[0]);
            return;
        }
        if (CB_SIZES_INT_UNSIGNED(l)) {
            uval = cb_get_u_long_long (x);
            switch (CB_SIZES_INT (l)) {
            case CB_SIZE_AUTO:
                if (uval > UINT_MAX) {
                    output ("(cob_u64_t)");
                    output (CB_FMT_LLU_F, uval);
                    return;
                }
                /* Fall through to case 4 */
            case CB_SIZE_4:
                output ("(cob_u32_t)");
                output (CB_FMT_LLU_F, uval);
                return;
            case CB_SIZE_1:
                output ("(cob_u8_t)");
                output (CB_FMT_LLU_F, uval);
                return;
            case CB_SIZE_2:
                output ("(cob_u16_t)");
                output (CB_FMT_LLU_F, uval);
                return;
            case CB_SIZE_8:
                output ("(cob_u64_t)");
                output (CB_FMT_LLU_F, uval);
                return;
            default:
                cobc_abort_pr (_("Unexpected size"));
                COBC_ABORT ();
            }
        }
        val = cb_get_long_long (x);
        switch (CB_SIZES_INT (l)) {
        case CB_SIZE_AUTO:
            if (val > INT_MAX) {
                output ("(cob_s64_t)");
                output (CB_FMT_LLD_F, val);
                return;
            }
            /* Fall through to case 4 */
        case CB_SIZE_4:
            output ("(cob_s32_t)");
            output (CB_FMT_LLD_F, val);
            return;
        case CB_SIZE_1:
            output ("(cob_s8_t)");
            output (CB_FMT_LLD_F, val);
            return;
        case CB_SIZE_2:
            output ("(cob_s16_t)");
            output (CB_FMT_LLD_F, val);
            return;
        case CB_SIZE_8:
            output ("(cob_s64_t)");
            output (CB_FMT_LLD_F, val);
            return;
        default:
            cobc_abort_pr (_("Unexpected size"));
            COBC_ABORT ();
        }
        return;
    default:
        f = cb_code_field (x);
        switch (f->usage) {
        case CB_USAGE_BINARY:
        case CB_USAGE_COMP_5:
        case CB_USAGE_COMP_X:
        case CB_USAGE_PACKED:
        case CB_USAGE_DISPLAY:
        case CB_USAGE_COMP_6:
            sizes = CB_SIZES_INT (l);
            sign = 0;
            if (sizes == CB_SIZE_AUTO) {
                if (f->pic->have_sign) {
                    sign = 1;
                }
                if (f->usage == CB_USAGE_PACKED ||
                    f->usage == CB_USAGE_DISPLAY ||
                    f->usage == CB_USAGE_COMP_6) {
                    sizes = f->pic->digits - f->pic->scale;
                } else {
                    sizes = f->size;
                }
                switch (sizes) {
                case 0:
                    sizes = CB_SIZE_4;
                    break;
                case 1:
                    sizes = CB_SIZE_1;
                    break;
                case 2:
                    sizes = CB_SIZE_2;
                    break;
                case 3:
                    sizes = CB_SIZE_4;
                    break;
                case 4:
                    sizes = CB_SIZE_4;
                    break;
                case 5:
                    sizes = CB_SIZE_8;
                    break;
                case 6:
                    sizes = CB_SIZE_8;
                    break;
                case 7:
                    sizes = CB_SIZE_8;
                    break;
                default:
                    sizes = CB_SIZE_8;
                    break;
                }
            } else {
                if (!CB_SIZES_INT_UNSIGNED(l)) {
                    sign = 1;
                }
            }
            switch (sizes) {
            case CB_SIZE_1:
                if (sign) {
                    s = "cob_c8_t";
                } else {
                    s = "cob_u8_t";
                }
                break;
            case CB_SIZE_2:
                if (sign) {
                    s = "cob_s16_t";
                } else {
                    s = "cob_u16_t";
                }
                break;
            case CB_SIZE_4:
                if (sign) {
                    s = "cob_s32_t";
                } else {
                    s = "cob_u32_t";
                }
                break;
            case CB_SIZE_8:
                if (sign) {
                    s = "cob_s64_t";
                } else {
                    s = "cob_u64_t";
                }
                break;
            default:
                if (sign) {
                    s = "cob_s32_t";
                } else {
                    s = "cob_u32_t";
                }
                break;
            }
            output ("(%s)(", s);
            output_integer (x);
            output (")");
            return;
        case CB_USAGE_INDEX:
        case CB_USAGE_LENGTH:
        case CB_USAGE_POINTER:
        case CB_USAGE_PROGRAM_POINTER:
            output_integer (x);
            return;
        case CB_USAGE_FLOAT:
            output ("*(float *)(");
            output_data (x);
            output (")");
            return;
        case CB_USAGE_DOUBLE:
            output ("*(double *)(");
            output_data (x);
            output (")");
            return;
        case CB_USAGE_LONG_DOUBLE:
            output ("*(long double *)(");
            output_data (x);
            output (")");
            return;
        case CB_USAGE_FP_BIN32:
            output ("*(cob_u32_t *)(");
            output_data (x);
            output (")");
            return;
        case CB_USAGE_FP_BIN64:
        case CB_USAGE_FP_DEC64:
            output ("*(cob_u64_t *)(");
            output_data (x);
            output (")");
            return;
        case CB_USAGE_FP_BIN128:
        case CB_USAGE_FP_DEC128:
            output ("*(cob_fp_128 *)(");
            output_data (x);
            output (")");
            return;
        default:
            output ("*(");
            output_data (x);
            output (")");
            return;
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_cancel ( struct cb_cancel *  p )

static

Definition at line 3858 of file codegen.c.

References cb_encode_program_id(), CB_LITERAL, CB_LITERAL_P, gen_nested_tab, nested_list::nested_prog, cb_program::nested_prog_list, nested_list::next, cb_program::num_proc_params, output(), output_param(), output_prefix(), output_string(), cb_program::program_id, cb_cancel::target, and cb_program::toplev_count.

Referenced by output_stmt().

{
    struct nested_list  *nlp;
    char            *callp;
    char            *s;
    int         i;

    if (CB_LITERAL_P (p->target)) {
        s = (char *)(CB_LITERAL (p->target)->data);
        callp = cb_encode_program_id (s);
        nlp = current_prog->nested_prog_list;
        for (; nlp; nlp = nlp->next) {
            if (!strcmp (callp, nlp->nested_prog->program_id)) {
                break;
            }
        }
        if (nlp) {
            output_prefix ();
            output ("(void)%s_%d_ (-1", callp,
                nlp->nested_prog->toplev_count);
            for (i = 0; i < nlp->nested_prog->num_proc_params; ++i) {
                output (", NULL");
            }
            output (");\n");
        } else {
            output ("cob_cancel (");
            output_string ((const unsigned char *)s,
                    (int)strlen (s), 0);
            output (");\n");
        }
        return;
    }
    output_prefix ();
    output ("cob_cancel_field (");
    output_param (p->target, -1);
    if (current_prog->nested_prog_list) {
        gen_nested_tab = 1;
        output (", cob_nest_tab");
    } else {
        output (", NULL");
    }
    output (");\n");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_class_name_definition ( struct cb_class_name *  p )

static

Definition at line 5544 of file codegen.c.

References CB_CHAIN, cb_high, CB_LITERAL, cb_low, cb_null, CB_NUMERIC_LITERAL_P, CB_PAIR_P, CB_PAIR_X, CB_PAIR_Y, cb_quote, cb_space, CB_VALUE, cb_zero, cb_class_name::cname, cb_class_name::list, literal_value(), output_indent(), output_line(), and output_newline().

Referenced by codegen().

{
    cb_tree     l;
    cb_tree     x;
    unsigned char   *data;
    size_t      i;
    size_t      size;
    int     n;
    int     lower;
    int     upper;
    int     vals[256];

    output_line ("static int");
    output_line ("%s (cob_field *f)", p->cname);
    output_indent ("{");
    output_line ("size_t\ti;\n");
    output_line ("for (i = 0; i < f->size; i++)");
    output_indent ("{");
    output_line ("switch (f->data[i]) {");
    memset (vals, 0, sizeof(vals));
    for (l = p->list; l; l = CB_CHAIN (l)) {
        x = CB_VALUE (l);
        if (CB_PAIR_P (x)) {
            lower = literal_value (CB_PAIR_X (x));
            upper = literal_value (CB_PAIR_Y (x));
            for (n = lower; n <= upper; ++n) {
                vals[n] = 1;
            }
        } else {
            if (CB_NUMERIC_LITERAL_P (x)) {
                vals[literal_value (x)] = 1;
            } else if (x == cb_space) {
                vals[' '] = 1;
            } else if (x == cb_zero) {
                vals['0'] = 1;
            } else if (x == cb_quote) {
                if (cb_flag_apostrophe) {
                    vals['\''] = 1;
                } else {
                    vals['"'] = 1;
                }
            } else if (x == cb_null) {
                vals[0] = 1;
            } else if (x == cb_low) {
                vals[0] = 1;
            } else if (x == cb_high) {
                vals[255] = 1;
            } else {
                size = CB_LITERAL (x)->size;
                data = CB_LITERAL (x)->data;
                for (i = 0; i < size; i++) {
                    vals[data[i]] = 1;
                }
            }
        }
    }
    for (i = 0; i < 256; ++i) {
        if (vals[i]) {
            output_line ("case %d:", (int)i);
        }
    }
    output_line ("    break;");
    output_line ("default:");
    output_line ("    return 0;");
    output_line ("}");
    output_indent ("}");
    output_line ("return 1;");
    output_indent ("}");
    output_newline ();
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_cond ( cb_tree  x, const int  save_flag  )

static

Definition at line 2121 of file codegen.c.

References _, CB_BINARY_OP, CB_CHAIN, cb_false, CB_TAG_BINARY_OP, CB_TAG_CONST, CB_TAG_FUNCALL, CB_TAG_LIST, CB_TREE_TAG, cb_true, CB_VALUE, COB_INSIDE_SIZE, COBC_ABORT, cobc_abort_pr(), inside_check, inside_stack, cb_binary_op::op, output(), output_funcall(), output_integer(), output_newline(), output_prefix(), output_stmt(), cb_binary_op::x, and cb_binary_op::y.

Referenced by output_perform_until(), output_search_all(), and output_stmt().

{
    struct cb_binary_op *p;

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_CONST:
        if (x == cb_true) {
            output ("1");
        } else if (x == cb_false) {
            output ("0");
        } else {
            cobc_abort_pr (_("Unexpected constant"));
            COBC_ABORT ();
        }
        break;
    case CB_TAG_BINARY_OP:
        p = CB_BINARY_OP (x);
        switch (p->op) {
        case '!':
            output ("!");
            output_cond (p->x, save_flag);
            break;

        case '&':
        case '|':
            output ("(");
            output_cond (p->x, save_flag);
            output (p->op == '&' ? " && " : " || ");
            output_newline ();
            output_prefix ();
            output ("    ");
            output_cond (p->y, save_flag);
            output (")");
            break;

        case '=':
        case '<':
        case '[':
        case '>':
        case ']':
        case '~':
            output ("((int)");
            output_cond (p->x, save_flag);
            switch (p->op) {
            case '=':
                output (" == 0");
                break;
            case '<':
                output (" < 0");
                break;
            case '[':
                output (" <= 0");
                break;
            case '>':
                output (" > 0");
                break;
            case ']':
                output (" >= 0");
                break;
            case '~':
                output (" != 0");
                break;
            default:
                /* FIXME - Check */
                break;
            }
            output (")");
            break;

        default:
            output_integer (x);
            break;
        }
        break;
    case CB_TAG_FUNCALL:
        if (save_flag) {
            output ("(ret = ");
        }
        output_funcall (x);
        if (save_flag) {
            output (")");
        }
        break;
    case CB_TAG_LIST:
        if (save_flag) {
            output ("(ret = ");
        }
        inside_stack[inside_check++] = 0;
        if (inside_check >= COB_INSIDE_SIZE) {
            cobc_abort_pr (_("Internal statement stack depth exceeded -> %d"),
                    COB_INSIDE_SIZE);
            COBC_ABORT ();
        }
        output ("(\n");
        for (; x; x = CB_CHAIN (x)) {
            output_stmt (CB_VALUE (x));
        }
        if (inside_check) {
            --inside_check;
        }
        output (")");
        if (save_flag) {
            output (")");
        }
        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 output_cond_debug ( cb_tree  x )

static

Definition at line 4138 of file codegen.c.

References CB_BINARY_OP, cb_build_debug(), cb_debug_contents, cb_debug_name, CB_REF_OR_FIELD_P, CB_TAG_BINARY_OP, CB_TAG_FUNCALL, CB_TAG_LIST, CB_TREE_TAG, NULL, cb_binary_op::op, output_funcall_debug(), output_perform_call(), output_stmt(), cb_binary_op::x, and cb_binary_op::y.

Referenced by output_perform_until().

{
    struct cb_binary_op *p;

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_FUNCALL:
        output_funcall_debug (x);
        break;
    case CB_TAG_LIST:
        break;
    case CB_TAG_BINARY_OP:
        p = CB_BINARY_OP (x);
        switch (p->op) {
        case '!':
            output_cond_debug (p->x);
            break;

        case '&':
        case '|':
            output_cond_debug (p->x);
            output_cond_debug (p->y);
            break;

        case '=':
        case '<':
        case '[':
        case '>':
        case ']':
        case '~':
            output_cond_debug (p->x);
            break;

        default:
            if (CB_REF_OR_FIELD_P (x) &&
                cb_code_field (x)->flag_field_debug) {
                output_stmt (cb_build_debug (cb_debug_name,
                         (const char *)cb_code_field (x)->name, NULL));
                output_stmt (cb_build_debug (cb_debug_contents,
                                 NULL, x));
                output_perform_call (cb_code_field (x)->debug_section,
                             cb_code_field (x)->debug_section);
            }
            break;
        }
        break;
    default:
        break;
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_data ( cb_tree  x )

static

Definition at line 705 of file codegen.c.

References _, CB_CHAIN, CB_CLASS_NUMERIC, CB_FIELD, CB_LITERAL, cb_null, CB_REFERENCE, CB_TAG_CAST, CB_TAG_CONST, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_CLASS, CB_TREE_TAG, CB_VALUE, cb_field::children, COBC_ABORT, cobc_abort_pr(), cb_literal::data, cb_field::depending, field_iteration, cb_field::flag_occurs, cb_literal::llit, NULL, cb_reference::offset, output(), output_base(), output_index(), output_integer(), output_param(), output_string(), cb_field::parent, cb_literal::sign, cb_literal::size, cb_field::size, cb_reference::subs, unlikely, and cb_reference::value.

Referenced by output_call(), output_call_by_value_args(), output_field(), output_figurative(), output_funcall(), output_initialize_fp(), output_initialize_fp_bindec(), output_initialize_literal(), output_initialize_one(), output_initialize_uniform(), output_integer(), output_internal_function(), output_long_integer(), output_param(), and output_stmt().

{
    struct cb_literal   *l;
    struct cb_reference *r;
    struct cb_field     *f;
    struct cb_field     *o_slide;
    struct cb_field     *o;
    cb_tree         lsub;

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_LITERAL:
        l = CB_LITERAL (x);
        if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) {
            output ("(cob_u8_ptr)\"%s%s\"", (char *)l->data,
                (l->sign < 0) ? "-" : (l->sign > 0) ? "+" : "");
        } else {
            output ("(cob_u8_ptr)");
            output_string (l->data, (int) l->size, l->llit);
        }
        break;
    case CB_TAG_REFERENCE:
        r = CB_REFERENCE (x);
        f = CB_FIELD (r->value);

        /* Base address */
        output_base (f, 0);

        /* Subscripts */
        if (r->subs) {
            lsub = r->subs;
            o_slide = NULL;
            for (; f && lsub; f = f->parent) {
                /* add current field size for OCCURS */
                if (f->flag_occurs) {
                    /* recalculate size for nested ODO ... */
                    if (unlikely(o_slide)) {
                        for (o = o_slide; o; o = o->children) {
                            if (o->depending) {
                                output (" + (%d * ", o->size);
                                output_integer (o->depending);
                                output (")");
                            }
                        }
                        output (" * ");
                    } else {
                    /* ... use field size otherwise */
                        output (" + ");
                        if (f->size != 1) {
                            output ("%d * ", f->size);
                        }
                    }
                    if (cb_flag_odoslide && f->depending) {
                        o_slide = f;
                    }

                    output_index (CB_VALUE (lsub));
                    lsub = CB_CHAIN (lsub);
                }
            }
        }

        /* Offset */
        if (r->offset) {
            output (" + ");
            output_index (r->offset);
        }
        break;
    case CB_TAG_CAST:
        output ("&");
        output_param (x, 0);
        break;
    case CB_TAG_INTRINSIC:
        output ("cob_procedure_params[%u]->data",
            field_iteration);
        break;
    case CB_TAG_CONST:
        if (x == cb_null) {
            output ("NULL");
            return;
        }
        /* Fall through */
    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 output_entry_function ( struct cb_program *  prog, cb_tree  entry, cb_tree  parameter_list, const int  gencode  )

static

Definition at line 6866 of file codegen.c.

References CB_CALL_BY_CONTENT, CB_CALL_BY_REFERENCE, CB_CALL_BY_VALUE, CB_CHAIN, CB_CLASS_NUMERIC, CB_FUNCTION_TYPE, CB_LABEL, CB_PREFIX_BASE, CB_PURPOSE, CB_PURPOSE_INT, CB_SIZE_1, CB_SIZE_2, CB_SIZE_4, CB_SIZE_8, CB_SIZE_UNSIGNED, CB_SIZES, CB_SIZES_INT, CB_TREE_CLASS, 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_USAGE_POINTER, CB_USAGE_PROGRAM_POINTER, CB_VALUE, COB_MAX_FIELD_PARAMS, cob_u32_t, f1, f2, cb_program::flag_chained, cb_program::flag_main, cb_program::flag_recursive, cb_program::flag_void, cb_field::id, n2, cb_field::name, cb_program::nested_level, NULL, output(), cb_program::prog_type, progid, cb_program::program_id, cb_program::toplev_count, unlikely, and cb_field::usage.

Referenced by codegen().

{
    const char      *entry_name;
    cb_tree         using_list;
    cb_tree         l;
    cb_tree         l1;
    cb_tree         l2;
    struct cb_field     *f;
    struct cb_field     *f1;
    struct cb_field     *f2;
    const char      *s;
    const char      *s2;
    const char      *s_prefix;
    const char      *s_type[COB_MAX_FIELD_PARAMS];
    cob_u32_t       parmnum;
    cob_u32_t       n;
#if 0   /* RXWRXW - UFUNC */
    cob_u32_t       n2;
#endif
    int         sticky_ids[COB_MAX_FIELD_PARAMS];
    int         sticky_nonp[COB_MAX_FIELD_PARAMS];

    entry_name = CB_LABEL (CB_PURPOSE (entry))->name;
    using_list = CB_VALUE (entry);

    if (gencode) {
        output ("/* ENTRY '%s' */\n\n", entry_name);
    }

#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(__clang__)
    if (!gencode && !prog->nested_level) {
        output ("__declspec(dllexport) ");
    }
#endif

    if (unlikely(prog->prog_type == CB_FUNCTION_TYPE)) {
        if (gencode) {
            output ("cob_field *\n");
        } else {
            output ("cob_field\t\t*");
        }
        output ("%s (", entry_name);
        if (!gencode) {
            output ("cob_field **, const int");
        } else {
            output ("cob_field **cob_fret, const int cob_pam");
        }
        parmnum = 0;
        if (using_list) {
            output (", ");
            n = 0;
            for (l = using_list; l; l = CB_CHAIN (l), ++n, ++parmnum) {
                if (!gencode) {
                    output ("cob_field *");
                } else {
                    output ("cob_field *f%u", n);
                }
                if (CB_CHAIN (l)) {
                    output (", ");
                }
            }
        }
        if (gencode) {
            output (")\n");
        } else {
            /* Finish prototype and return */
            output (");\n");
            return;
        }
        output ("{\n");
        output ("  struct cob_func_loc\t*floc;\n\n");
        output ("  /* Save environment */\n");
        output ("  floc = cob_save_func (cob_fret, cob_pam, %u",
            parmnum);
#if 0   /* RXWRXW - UFUNC */
        if (!using_list) {
            output ("  floc->ret_fld = %s_ (0);\n", prog->program_id);
            output ("  **cob_fret = *floc->ret_fld;\n");
            output ("  cob_restore_func (floc);\n");
            output ("  return *cob_fret;\n}\n\n");
            return;
        }
        output ("  switch (cob_pam) {\n");
        for (n = 0; n <= parmnum; ++n) {
            if (!n) {
                output ("  case 0:\n");
                output ("    break;\n");
                continue;
            }
            output ("  case %u:\n", n);
            if (n == parmnum) {
                output ("  default:\n");
            }
            for (n2 = 0; n2 < n; ++n2) {
                output ("    if (f%u) {\n", n2);
                output ("      floc->func_params[%u] = f%u;\n",
                    n2, n2);
                output ("      floc->data[%u] = f%u->data;\n",
                    n2, n2);
                output ("    }\n");
                output ("    break;\n");
            }
        }
#else
        for (n = 0; n < parmnum; ++n) {
            output (", f%u", n);
        }
#endif
        output (");\n");

        output ("  floc->ret_fld = %s_ (0", prog->program_id);
        if (parmnum != 0) {
            output (", ");
            for (n = 0; n < parmnum; ++n) {
                output ("floc->data[%u]", n);
                if (n != parmnum - 1) {
                    output (", ");
                }
            }
        }
        output (");\n");
        output ("  **cob_fret = *floc->ret_fld;\n");
        output ("  /* Restore environment */\n");
        output ("  cob_restore_func (floc);\n");
        output ("  return *cob_fret;\n}\n\n");
        return;
    }
    if (prog->nested_level) {
        if (gencode) {
            if (prog->flag_void) {
                output("void\n");
            } else {
                output ("static int\n");
            }
        } else {
            if (prog->flag_void) {
                output("void\t\t");
            } else {
                output ("static int\t\t");
            }
        }
    } else {
        if (prog->flag_main && !prog->flag_recursive) {
            output ("static ");
        }
        if (gencode) {
            if (prog->flag_void) {
                output ("void\n");
            } else {
                output ("int\n");
            }
        } else {
            if (prog->flag_void) {
                output ("void\t\t\t");
            } else {
                output ("int\t\t\t");
            }
        }
    }

    if (prog->nested_level) {
        output ("%s_%d__ (", entry_name, prog->toplev_count);
    } else {
        output ("%s (", entry_name);
    }
    if (prog->flag_chained) {
        using_list = NULL;
        parameter_list = NULL;
    }
    if (!gencode && !using_list) {
        output ("void);\n");
        return;
    }

    memset (sticky_ids, 0, sizeof(sticky_ids));
    memset (sticky_nonp, 0, sizeof(sticky_ids));

    n = 0;
    for (l = using_list; l; l = CB_CHAIN (l), ++n) {
        f = cb_code_field (CB_VALUE (l));
        switch (CB_PURPOSE_INT (l)) {
        case CB_CALL_BY_VALUE:
            if (f->usage == CB_USAGE_FLOAT) {
                if (gencode) {
                    output ("float %s%d",
                        CB_PREFIX_BASE, f->id);
                } else {
                    output ("float");
                }
                if (cb_sticky_linkage) {
                    s_type[n] = "";
                } else {
                    s_type[n] = "(cob_u8_ptr)&";
                }
                break;
            } else if (f->usage == CB_USAGE_DOUBLE) {
                if (gencode) {
                    output ("double %s%d",
                        CB_PREFIX_BASE, f->id);
                } else {
                    output ("double");
                }
                if (cb_sticky_linkage) {
                    s_type[n] = "";
                } else {
                    s_type[n] = "(cob_u8_ptr)&";
                }
                break;
            } else if (f->usage == CB_USAGE_LONG_DOUBLE) {
                if (gencode) {
                    output ("long double %s%d",
                        CB_PREFIX_BASE, f->id);
                } else {
                    output ("long double");
                }
                if (cb_sticky_linkage) {
                    s_type[n] = "";
                } else {
                    s_type[n] = "(cob_u8_ptr)&";
                }
                break;
            } else if (f->usage == CB_USAGE_FP_BIN32) {
                if (gencode) {
                    output ("cob_u32_t %s%d",
                        CB_PREFIX_BASE, f->id);
                } else {
                    output ("cob_u32_t");
                }
                if (cb_sticky_linkage) {
                    s_type[n] = "";
                } else {
                    s_type[n] = "(cob_u8_ptr)&";
                }
                break;
            } else if (f->usage == CB_USAGE_FP_BIN64 ||
                   f->usage == CB_USAGE_FP_DEC64) {
                if (gencode) {
                    output ("cob_u64_t %s%d",
                        CB_PREFIX_BASE, f->id);
                } else {
                    output ("cob_u64_t");
                }
                if (cb_sticky_linkage) {
                    s_type[n] = "";
                } else {
                    s_type[n] = "(cob_u8_ptr)&";
                }
                break;
            } else if (f->usage == CB_USAGE_FP_BIN128 ||
                   f->usage == CB_USAGE_FP_DEC128) {
                if (gencode) {
                    output ("cob_fp_128 %s%d",
                        CB_PREFIX_BASE, f->id);
                } else {
                    output ("cob_fp_128");
                }
                if (cb_sticky_linkage) {
                    s_type[n] = "";
                } else {
                    s_type[n] = "(cob_u8_ptr)&";
                }
                break;
            } else if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_NUMERIC) {
                s = "";
                switch (CB_SIZES_INT (l)) {
                case CB_SIZE_1:
                    if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                        s = "cob_u8_t";
                    } else {
                        s = "cob_c8_t";
                    }
                    break;
                case CB_SIZE_2:
                    if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                        s = "cob_u16_t";
                    } else {
                        s = "cob_s16_t";
                    }
                    break;
                case CB_SIZE_4:
                    if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                        s = "cob_u32_t";
                    } else {
                        s = "cob_s32_t";
                    }
                    break;
                case CB_SIZE_8:
                    if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                        s = "cob_u64_t";
                    } else {
                        s = "cob_s64_t";
                    }
                    break;
                default:
                    break;
                }
                if (gencode) {
                    output ("%s %s%d",
                        s, CB_PREFIX_BASE, f->id);
                } else {
                    output ("%s", s);
                }
                if (cb_sticky_linkage) {
                    s_type[n] = "";
                } else {
                    s_type[n] = "(cob_u8_ptr)&";
                }
                break;
            }
            /* Fall through */
        case CB_CALL_BY_REFERENCE:
        case CB_CALL_BY_CONTENT:
            if (gencode) {
                output ("cob_u8_t *%s%d",
                    CB_PREFIX_BASE, f->id);
            } else {
                output ("cob_u8_t *");
            }
            s_type[n] = "";
            break;
        default:
            break;
        }
        if (CB_CHAIN (l)) {
            output (", ");
        }
    }

    if (gencode) {
        output (")\n");
    } else {
        /* Finish prototype and return */
        output (");\n");
        return;
    }

    output ("{\n");

    /* We have to cater for sticky-linkage here at the entry point site */
    /* Doing it in the internal function is too late as we */
    /* then do not have the information as to possible ENTRY clauses */

    parmnum = 0;
    /* Sticky linkage parameters */
    if (cb_sticky_linkage && using_list) {
        for (l = using_list; l; l = CB_CHAIN (l), parmnum++) {
            f = cb_code_field (CB_VALUE (l));
            sticky_ids[parmnum] = f->id;
            switch (CB_PURPOSE_INT (l)) {
            case CB_CALL_BY_VALUE:
                s = NULL;
                s2 = "0";
                if (f->usage == CB_USAGE_FLOAT) {
                    s = "float";
                } else if (f->usage == CB_USAGE_DOUBLE) {
                    s = "double";
                } else if (f->usage == CB_USAGE_LONG_DOUBLE) {
                    s = "long double";
                } else if (f->usage == CB_USAGE_FP_BIN32) {
                    s = "cob_u32_t";
                } else if (f->usage == CB_USAGE_FP_BIN64 ||
                       f->usage == CB_USAGE_FP_DEC64) {
                    s = "cob_u64_t";
                } else if (f->usage == CB_USAGE_FP_BIN128 ||
                       f->usage == CB_USAGE_FP_DEC128) {
                    s = "cob_fp_128";
                    s2 = "{{0, 0}}";
                } else if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_NUMERIC) {
                    switch (CB_SIZES_INT (l)) {
                    case CB_SIZE_1:
                        if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                            s = "cob_u8_t";
                        } else {
                            s = "cob_c8_t";
                        }
                        break;
                    case CB_SIZE_2:
                        if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                            s = "cob_u16_t";
                        } else {
                            s = "cob_s16_t";
                        }
                        break;
                    case CB_SIZE_4:
                        if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                            s = "cob_u32_t";
                        } else {
                            s = "cob_s32_t";
                        }
                        break;
                    case CB_SIZE_8:
                        if (CB_SIZES(l) & CB_SIZE_UNSIGNED) {
                            s = "cob_u64_t";
                        } else {
                            s = "cob_s64_t";
                        }
                        break;
                    default:
                        break;
                    }
                }
                if (s) {
                    output ("  static %s\tcob_parm_l_%d = %s;\n",
                        s, f->id, s2);
                    sticky_nonp[parmnum] = 1;
                    break;
                }
                /* Fall through */
            case CB_CALL_BY_REFERENCE:
            case CB_CALL_BY_CONTENT:
                break;
            default:
                break;
            }
        }
    }

    /* By value pointer fields */
    for (l2 = using_list; l2; l2 = CB_CHAIN (l2)) {
        f2 = cb_code_field (CB_VALUE (l2));
        if (CB_PURPOSE_INT (l2) == CB_CALL_BY_VALUE &&
            (f2->usage == CB_USAGE_POINTER ||
             f2->usage == CB_USAGE_PROGRAM_POINTER)) {
            output ("  unsigned char\t\t*ptr_%d;\n", f2->id);
        }
    }

    /* Sticky linkage set up */
    if (cb_sticky_linkage && using_list) {
        parmnum = 0;
        output ("  switch (cob_get_global_ptr ()->cob_call_params) {\n");
        for (l = using_list; l; l = CB_CHAIN (l), parmnum++) {
            output ("  case %u:\n", parmnum);
            for (n = 0; n < parmnum; ++n) {
                if (sticky_nonp[n]) {
                    output ("\tcob_parm_l_%d = %s%d;\n",
                        sticky_ids[n], CB_PREFIX_BASE,
                        sticky_ids[n]);
                    output ("\tcob_parm_%d = (cob_u8_ptr)&cob_parm_l_%d;\n",
                        sticky_ids[n],
                        sticky_ids[n]);
                } else {
                    output ("\tcob_parm_%d = %s%d;\n",
                        sticky_ids[n], CB_PREFIX_BASE,
                        sticky_ids[n]);
                }
            }
            output ("\tbreak;\n");
        }
        output ("  default:\n");
        for (n = 0; n < parmnum; ++n) {
            if (sticky_nonp[n]) {
                output ("\tcob_parm_l_%d = %s%d;\n",
                    sticky_ids[n], CB_PREFIX_BASE,
                    sticky_ids[n]);
                output ("\tcob_parm_%d = (cob_u8_ptr)&cob_parm_l_%d;\n",
                    sticky_ids[n],
                    sticky_ids[n]);
            } else {
                output ("\tcob_parm_%d = %s%d;\n",
                    sticky_ids[n], CB_PREFIX_BASE,
                    sticky_ids[n]);
            }
        }
        output ("\tbreak;\n");
        output ("  }\n");
    }

    if (cb_sticky_linkage) {
        s_prefix = "cob_parm_";
    } else {
        s_prefix = CB_PREFIX_BASE;
    }

    for (l2 = using_list; l2; l2 = CB_CHAIN (l2)) {
        f2 = cb_code_field (CB_VALUE (l2));
        if (CB_PURPOSE_INT (l2) == CB_CALL_BY_VALUE &&
            (f2->usage == CB_USAGE_POINTER ||
             f2->usage == CB_USAGE_PROGRAM_POINTER)) {
            output ("  ptr_%d = %s%d;\n",
                f2->id, s_prefix, f2->id);
        }
    }

    if (!prog->nested_level) {
        if (prog->flag_void) {
            output ("  return (void)%s_ (%d", prog->program_id, progid++);
        } else {
            output ("  return %s_ (%d", prog->program_id, progid++);
        }
    } else {
        if (prog->flag_void) {
            output ("  return (void)%s_%d_ (%d", prog->program_id,
                prog->toplev_count, progid++);
        } else {
            output ("  return %s_%d_ (%d", prog->program_id,
                prog->toplev_count, progid++);
        }
    }

    if (!using_list && !parameter_list) {
        output (");\n");
        output ("}\n\n");
        return;
    }

    for (l1 = parameter_list; l1; l1 = CB_CHAIN (l1)) {
        f1 = cb_code_field (CB_VALUE (l1));
        n = 0;
        for (l2 = using_list; l2; l2 = CB_CHAIN (l2), ++n) {
            f2 = cb_code_field (CB_VALUE (l2));
            if (strcasecmp (f1->name, f2->name) == 0) {
                switch (CB_PURPOSE_INT (l2)) {
                case CB_CALL_BY_VALUE:
                    if (f2->usage == CB_USAGE_POINTER ||
                        f2->usage == CB_USAGE_PROGRAM_POINTER) {
                        output (", (cob_u8_ptr)&ptr_%d", f2->id);
                        break;
                    }
                    /* Fall through */
                case CB_CALL_BY_REFERENCE:
                case CB_CALL_BY_CONTENT:
                    output (", %s%s%d",
                        s_type[n], s_prefix, f2->id);
                    break;
                default:
                    break;
                }
                break;
            }
        }
        if (l2 == NULL) {
            if (cb_sticky_linkage) {
                output (", %s%d",
                    s_prefix, f1->id);
            } else {
                output (", NULL");
            }
        }
    }
    output (");\n");
    output ("}\n\n");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_error_handler ( struct cb_program *  prog )

static

Definition at line 5635 of file codegen.c.

References CB_LABEL, cb_list_length(), cb_standard_error_handler, COB_OPEN_EXTEND, COB_OPEN_INPUT, cb_program::global_handler, handler_struct::handler_label, handler_struct::handler_prog, cb_label::id, cb_program::nested_level, output(), output_indent(), output_line(), output_newline(), output_perform_call(), output_perform_exit(), output_prefix(), output_stmt(), cb_program::parameter_list, cb_program::program_id, and cb_program::toplev_count.

Referenced by output_internal_function().

{
    struct handler_struct   *hstr;
    size_t          seen;
    int         i;
    int         n;
    int         parmnum;

    output_newline ();
    seen = 0;
    for (i = COB_OPEN_INPUT; i <= COB_OPEN_EXTEND; i++) {
        if (prog->global_handler[i].handler_label) {
            seen = 1;
            break;
        }
    }
    output_stmt (cb_standard_error_handler);
    output_newline ();
    if (seen) {
        output_line ("switch (cob_glob_ptr->cob_error_file->last_open_mode)");
        output_indent ("{");
        for (i = COB_OPEN_INPUT; i <= COB_OPEN_EXTEND; i++) {
            hstr = &prog->global_handler[i];
            if (hstr->handler_label) {
                output_line ("case %d:", i);
                output_indent ("{");
                if (prog == hstr->handler_prog) {
                    output_perform_call (hstr->handler_label,
                                 hstr->handler_label);
                } else {
                    output_prefix ();
                    if (hstr->handler_prog->nested_level) {
                        output ("%s_%d_ (%d",
                            hstr->handler_prog->program_id,
                            hstr->handler_prog->toplev_count,
                            hstr->handler_label->id);
                    } else {
                        output ("%s_ (%d",
                            hstr->handler_prog->program_id,
                            hstr->handler_label->id);
                    }
                    parmnum = cb_list_length (hstr->handler_prog->parameter_list);
                    for (n = 0; n < parmnum; n++) {
                        output (", NULL");
                    }
                    output (");\n");
                }
                output_line ("break;");
                output_indent ("}");
            }
        }
        output_line ("default:");
        output_indent ("{");
    }
    output_line ("if (!(cob_glob_ptr->cob_error_file->flag_select_features & COB_SELECT_FILE_STATUS)) {");
    output_line ("\tcob_fatal_error (COB_FERROR_FILE);");
    output_line ("}");
    if (seen) {
        output_line ("break;");
        output_indent ("}");
        output_indent ("}");
    }
    output_perform_exit (CB_LABEL (cb_standard_error_handler));
    output_newline ();
    output_line ("/* Fatal error if reached */");
    output_line ("cob_fatal_error (COB_FERROR_CODEGEN);");
    output_newline ();
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_ferror_stmt ( struct cb_statement *  p, const int  code  )

static

Definition at line 4489 of file codegen.c.

References CB_FILE, cb_statement::file, cb_statement::handler1, cb_statement::handler2, cb_statement::handler3, output_file_error(), output_indent(), output_line(), and output_stmt().

Referenced by output_stmt().

{
    output_line ("if (unlikely(cob_glob_ptr->cob_exception_code != 0))");
    output_indent ("{");
    if (p->handler1) {
        if ((code & 0x00ff) == 0) {
            output_line ("if ((cob_glob_ptr->cob_exception_code & 0xff00) == 0x%04x)",
                 code);
        } else {
            output_line ("if (cob_glob_ptr->cob_exception_code == 0x%04x)", code);
        }
        output_indent ("{");
        output_stmt (p->handler1);
        output_indent ("}");
        output_line ("else");
        output_indent ("{");
    }
    output_file_error (CB_FILE (p->file));
    output_indent ("}");
    if (p->handler1) {
        output_indent ("}");
    }
    if (p->handler2 || p->handler3) {
        output_line ("else");
        output_indent ("{");
        if (p->handler3) {
            output_stmt (p->handler3);
        }
        if (p->handler2) {
            output_stmt (p->handler2);
        }
        output_indent ("}");
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_field ( cb_tree  x )

static

Definition at line 1045 of file codegen.c.

References output(), output_attr(), output_data(), and output_size().

Referenced by codegen(), lookup_literal(), and output_param().

{
    output ("{");
    output_size (x);
    output (", ");
    output_data (x);
    output (", ");
    output_attr (x);
    output ("}");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_figurative ( cb_tree  x, const struct cb_field *  f, const int  value, const int  init_occurs  )

static

Definition at line 2368 of file codegen.c.

References CB_REFERENCE, CB_REFERENCE_P, cb_field::occurs_max, output(), output_data(), output_prefix(), output_size(), and cb_field::size.

Referenced by output_initialize_one().

{
    output_prefix ();
    /* Check for non-standard 01 OCCURS */
    if (init_occurs) {
        output ("memset (");
        output_data (x);
        output (", %d, %d);\n", value, f->occurs_max);
    } else if (f->size == 1) {
        output ("*(cob_u8_ptr)(");
        output_data (x);
        output (") = %d;\n", value);
    } else {
        output ("memset (");
        output_data (x);
        if (CB_REFERENCE_P(x) && CB_REFERENCE(x)->length) {
            output (", %d, ", value);
            output_size (x);
            output (");\n");
        } else {
            output (", %d, %d);\n", value, f->size);
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int output_file_allocation ( struct cb_file *  f )

static

Definition at line 5099 of file codegen.c.

References cb_alphabet_name::alphabet_type, CB_ALPHABET_ASCII, CB_ALPHABET_CUSTOM, CB_ALPHABET_EBCDIC, CB_FIELD_PTR, CB_PREFIX_FILE, CB_PREFIX_KEYS, cb_file::cname, COB_ORG_INDEXED, COB_ORG_RELATIVE, cb_file::code_set, cb_file::file_status, cb_file::flag_global, gen_custom, gen_ebcdic_ascii, gen_full_ebcdic, gen_native, cb_file::linage, cb_file::name, cb_file::organization, output_local(), and output_storage().

Referenced by output_internal_function().

{

    if (f->flag_global) {
#if 0   /* RXWRXW - Global status */
        if (f->file_status) {
            /* Force status into main storage file */
            CB_FIELD_PTR (f->file_status)->flag_is_global = 1;
        }
#endif
        output_storage ("\n/* Global file %s */\n", f->name);
    } else {
        output_local ("\n/* File %s */\n", f->name);
    }
    /* Output RELATIVE/RECORD KEY's */
    if (f->organization == COB_ORG_RELATIVE ||
        f->organization == COB_ORG_INDEXED) {
        if (f->flag_global) {
            output_storage ("static cob_file_key\t*%s%s = NULL;\n",
                CB_PREFIX_KEYS, f->cname);
        } else {
            output_local ("static cob_file_key\t*%s%s = NULL;\n",
                CB_PREFIX_KEYS, f->cname);
        }
    }
    if (f->flag_global) {
        output_storage ("static cob_file\t\t*%s%s = NULL;\n",
            CB_PREFIX_FILE, f->cname);
        output_storage ("static unsigned char\t%s%s_status[4];\n",
            CB_PREFIX_FILE, f->cname);
    } else {
        output_local ("static cob_file\t\t*%s%s = NULL;\n",
            CB_PREFIX_FILE, f->cname);
        output_local ("static unsigned char\t%s%s_status[4];\n",
            CB_PREFIX_FILE, f->cname);
    }

    if (f->code_set) {
        gen_native = 1;
        switch (f->code_set->alphabet_type) {
        case CB_ALPHABET_ASCII:
            gen_ebcdic_ascii = 1;
            break;
        case CB_ALPHABET_EBCDIC:
            gen_full_ebcdic = 1;
            break;
        case CB_ALPHABET_CUSTOM:
            gen_custom = 1;
            break;
        default:
            break;
        }
    }

    if (f->linage) {
        return 1;
    }
    return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_file_error ( struct cb_file *  pfile )

static

Definition at line 4326 of file codegen.c.

References cb_build_debug(), CB_CHAIN, cb_debug_contents, CB_FILE, CB_VALUE, cb_program::flag_gen_debug, cb_program::global_file_list, cb_file::handler, cb_file::handler_prog, cb_label::id, cb_program::local_file_list, cb_file::name, cb_program::nested_level, NULL, output_line(), output_perform_call(), output_stmt(), cb_program::program_id, and cb_program::toplev_count.

Referenced by output_ferror_stmt().

{
    struct cb_file      *fl;
    cb_tree         l;

    if (current_prog->flag_gen_debug) {
        output_stmt (cb_build_debug (cb_debug_contents,
                         "USE PROCEDURE", NULL));
    }
    for (l =  current_prog->local_file_list; l; l = CB_CHAIN (l)) {
        fl = CB_FILE(CB_VALUE (l));
        if (!strcmp (pfile->name, fl->name)) {
            output_perform_call (fl->handler,
                         fl->handler);
            return;
        }
    }
    for (l =  current_prog->global_file_list; l; l = CB_CHAIN (l)) {
        fl = CB_FILE(CB_VALUE (l));
        if (!strcmp (pfile->name, fl->name)) {
            if (fl->handler_prog == current_prog) {
                output_perform_call (fl->handler,
                             fl->handler);
            } else {
                if (fl->handler_prog->nested_level) {
                    output_line ("%s_%d_ (%d);",
                        fl->handler_prog->program_id,
                        fl->handler_prog->toplev_count,
                        fl->handler->id);
                } else {
                    output_line ("%s_ (%d);",
                        fl->handler_prog->program_id,
                        fl->handler->id);
                }
            }
            return;
        }
    }
    output_perform_call (pfile->handler, pfile->handler);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_file_initialization ( struct cb_file *  f )

static

Definition at line 5160 of file codegen.c.

References cb_file::access_mode, cb_file::alt_key_list, cb_file::assign, CB_PREFIX_FILE, CB_PREFIX_KEYS, CB_TREE, cb_file::cname, COB_FILE_VERSION, COB_ORG_INDEXED, COB_ORG_RELATIVE, COB_SELECT_EXTERNAL, COB_SELECT_FILE_STATUS, COB_SELECT_LINAGE, cb_alt_key::duplicates, cb_file::file_status, cb_file::flag_ext_assign, cb_file::flag_external, cb_alt_key::key, cb_file::key, cb_file::latbot, cb_file::latfoot, cb_file::lattop, cb_file::linage, cb_file::linage_ctr, cb_file::lock_mode, cb_file::name, cb_alt_key::next, cb_file::optional, cb_file::organization, output(), output_indent(), output_line(), output_param(), output_prefix(), cb_file::record, cb_file::record_depending, cb_file::record_max, cb_file::record_min, and cb_file::special.

Referenced by output_internal_function().

{
    struct cb_alt_key   *l;
    int         nkeys;
    int         features;

    nkeys = 1;
    if (f->flag_external) {
        output_line ("%s%s = cob_external_addr (\"%s\", sizeof(cob_file));",
                 CB_PREFIX_FILE, f->cname, f->cname);
        output_line ("if (cob_glob_ptr->cob_initial_external)");
        output_indent ("{");
        if (f->linage) {
            output_line ("%s%s->linorkeyptr = cob_cache_malloc (sizeof(cob_linage));", CB_PREFIX_FILE, f->cname);
        }
    } else {
        output_line ("if (!%s%s)", CB_PREFIX_FILE, f->cname);
        output_indent ("{");
        output_line ("%s%s = cob_cache_malloc (sizeof(cob_file));", CB_PREFIX_FILE, f->cname);
        if (f->linage) {
            output_line ("%s%s->linorkeyptr = cob_cache_malloc (sizeof(cob_linage));", CB_PREFIX_FILE, f->cname);
        }
        output_indent ("}");
    }
    /* Output RELATIVE/RECORD KEY's */
    if (f->organization == COB_ORG_RELATIVE
     || f->organization == COB_ORG_INDEXED) {
        for (l = f->alt_key_list; l; l = l->next) {
            nkeys++;
        }
        output_line ("if (!%s%s)", CB_PREFIX_KEYS, f->cname);
        output_indent ("{");
        output_line ("%s%s = cob_cache_malloc (sizeof (cob_file_key) * %d);",
                 CB_PREFIX_KEYS, f->cname, nkeys);
        output_indent ("}");
        nkeys = 1;
        output_prefix ();
        output ("%s%s->field = ", CB_PREFIX_KEYS, f->cname);
        output_param (f->key, -1);
        output (";\n");
        output_prefix ();
        output ("%s%s->flag = 0;\n", CB_PREFIX_KEYS, f->cname);
        output_prefix ();
        if (f->key) {
            output ("%s%s->offset = %d;\n", CB_PREFIX_KEYS, f->cname,
                cb_code_field (f->key)->offset);
        } else {
            output ("%s%s->offset = 0;\n", CB_PREFIX_KEYS, f->cname);
        }
        for (l = f->alt_key_list; l; l = l->next) {
            output_prefix ();
            output ("(%s%s + %d)->field = ", CB_PREFIX_KEYS, f->cname,
                nkeys);
            output_param (l->key, -1);
            output (";\n");
            output_prefix ();
            output ("(%s%s + %d)->flag = %d;\n", CB_PREFIX_KEYS,
                f->cname, nkeys, l->duplicates);
            output_prefix ();
            output ("(%s%s + %d)->offset = %d;\n", CB_PREFIX_KEYS,
                f->cname, nkeys, cb_code_field (l->key)->offset);
            nkeys++;
        }
    }

    output_line ("%s%s->select_name = (const char *)\"%s\";", CB_PREFIX_FILE,
             f->cname, f->name);
    if (f->flag_external && !f->file_status) {
        output_line ("%s%s->file_status = cob_external_addr (\"%s%s_status\", 4);",
                 CB_PREFIX_FILE, f->cname, CB_PREFIX_FILE, f->cname);
    } else {
        output_line ("%s%s->file_status = %s%s_status;", CB_PREFIX_FILE,
                 f->cname, CB_PREFIX_FILE, f->cname);
        output_line ("memset (%s%s_status, '0', 2);", CB_PREFIX_FILE,
                 f->cname);
    }
    output_prefix ();
    output ("%s%s->assign = ", CB_PREFIX_FILE, f->cname);
    output_param (f->assign, -1);
    output (";\n");
    output_prefix ();
    output ("%s%s->record = ", CB_PREFIX_FILE, f->cname);
    output_param (CB_TREE (f->record), -1);
    output (";\n");
    output_prefix ();
    output ("%s%s->variable_record = ", CB_PREFIX_FILE, f->cname);
    if (f->record_depending) {
        output_param (f->record_depending, -1);
    } else {
        output ("NULL");
    }
    output (";\n");
    output_line ("%s%s->record_min = %d;", CB_PREFIX_FILE,
             f->cname, f->record_min);
    output_line ("%s%s->record_max = %d;", CB_PREFIX_FILE,
             f->cname, f->record_max);
    if (f->organization == COB_ORG_RELATIVE
     || f->organization == COB_ORG_INDEXED) {
        output_line ("%s%s->nkeys = %d;", CB_PREFIX_FILE,
                 f->cname, nkeys);
        output_line ("%s%s->keys = %s%s;", CB_PREFIX_FILE,
                 f->cname, CB_PREFIX_KEYS, f->cname);
    } else {
        output_line ("%s%s->nkeys = 0;", CB_PREFIX_FILE, f->cname);
        output_line ("%s%s->keys = NULL;", CB_PREFIX_FILE, f->cname);
    }
    output_line ("%s%s->file = NULL;", CB_PREFIX_FILE, f->cname);

    if (f->linage) {
        output_line ("lingptr = %s%s->linorkeyptr;",
                CB_PREFIX_FILE, f->cname);
        output_prefix ();
        output ("lingptr->linage = ");
        output_param (f->linage, -1);
        output (";\n");
        output_prefix ();
        output ("lingptr->linage_ctr = ");
        output_param (f->linage_ctr, -1);
        output (";\n");
        if (f->latfoot) {
            output_prefix ();
            output ("lingptr->latfoot = ");
            output_param (f->latfoot, -1);
            output (";\n");
        } else {
            output_line ("lingptr->latfoot = NULL;");
        }
        if (f->lattop) {
            output_prefix ();
            output ("lingptr->lattop = ");
            output_param (f->lattop, -1);
            output (";\n");
        } else {
            output_line ("lingptr->lattop = NULL;");
        }
        if (f->latbot) {
            output_prefix ();
            output ("lingptr->latbot = ");
            output_param (f->latbot, -1);
            output (";\n");
        } else {
            output_line ("lingptr->latbot = NULL;");
        }
        output_line ("lingptr->lin_lines = 0;");
        output_line ("lingptr->lin_foot = 0;");
        output_line ("lingptr->lin_top = 0;");
        output_line ("lingptr->lin_bot = 0;");
    }

    output_line ("%s%s->fd = -1;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->organization = %d;", CB_PREFIX_FILE, f->cname,
             f->organization);
    output_line ("%s%s->access_mode = %d;", CB_PREFIX_FILE, f->cname,
             f->access_mode);
    output_line ("%s%s->lock_mode = %d;", CB_PREFIX_FILE, f->cname,
             f->lock_mode);
    output_line ("%s%s->open_mode = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_optional = %d;", CB_PREFIX_FILE, f->cname,
             f->optional);
    output_line ("%s%s->last_open_mode = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_operation = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_nonexistent = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_end_of_file = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_begin_of_file = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_first_read = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_read_done = 0;", CB_PREFIX_FILE, f->cname);
    features = 0;
    if (f->file_status) {
        features |= COB_SELECT_FILE_STATUS;
    }
    if (f->linage) {
        features |= COB_SELECT_LINAGE;
    }
    if (f->flag_ext_assign) {
        features |= COB_SELECT_EXTERNAL;
    }
    if (f->special) {
        /* Special assignment */
        features |= f->special;
    }
    output_line ("%s%s->flag_select_features = %d;", CB_PREFIX_FILE, f->cname,
             features);
    output_line ("%s%s->flag_needs_nl = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->flag_needs_top = 0;", CB_PREFIX_FILE, f->cname);
    output_line ("%s%s->file_version = %d;", CB_PREFIX_FILE, f->cname,
             COB_FILE_VERSION);
    if (f->flag_external) {
        output_indent ("}");
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_func_1 ( const char *  name, cb_tree  x  )

static

Definition at line 2111 of file codegen.c.

References output(), output_param(), and param_id.

Referenced by output_integer(), and output_long_integer().

{
    output ("%s (", name);
    output_param (x, param_id);
    output (")");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_funcall ( cb_tree  x )

static

Definition at line 2028 of file codegen.c.

References _, cb_funcall::argc, cb_funcall::argv, CB_CHAIN, CB_FUNCALL, cb_high, CB_LITERAL, CB_LITERAL_P, cb_low, cb_space, CB_VALUE, cb_zero, COBC_ABORT, cobc_abort_pr(), cb_funcall::name, nolitcast, cb_funcall::nolitcast, output(), output_data(), output_param(), screenptr, cb_funcall::screenptr, and cb_funcall::varcnt.

Referenced by output_cond(), output_param(), and output_stmt().

{
    struct cb_funcall   *p;
    cb_tree         l;
    int         i;

    p = CB_FUNCALL (x);
    if (p->name[0] == '$') {
        switch (p->name[1]) {
        case 'E':
            /* Set of one character */
            output ("*(");
            output_data (p->argv[0]);
            output (") = ");
            output_param (p->argv[1], 1);
            break;
        case 'F':
            /* Move of one character */
            output ("*(");
            output_data (p->argv[0]);
            output (") = *(");
            output_data (p->argv[1]);
            output (")");
            break;
        case 'G':
            /* Test of one character */
            output ("(int)(*(");
            output_data (p->argv[0]);
            if (p->argv[1] == cb_space) {
                output (") - ' ')");
            } else if (p->argv[1] == cb_zero) {
                output (") - '0')");
            } else if (p->argv[1] == cb_low) {
                output ("))");
            } else if (p->argv[1] == cb_high) {
                output (") - 255)");
            } else if (CB_LITERAL_P (p->argv[1])) {
                output (") - %d)", *(CB_LITERAL (p->argv[1])->data));
            } else {
                output (") - *(");
                output_data (p->argv[1]);
                output ("))");
            }
            break;
        default:
            cobc_abort_pr (_("Unexpected function %s"), p->name);
            COBC_ABORT ();
        }
        return;
    }
    screenptr = p->screenptr;
    output ("%s (", p->name);
    for (i = 0; i < p->argc; i++) {
        if (p->varcnt && i + 1 == p->argc) {
            output ("%d, ", p->varcnt);
            for (l = p->argv[i]; l; l = CB_CHAIN (l)) {
                if (CB_VALUE (l) && CB_LITERAL_P (CB_VALUE (l))) {
                    nolitcast = p->nolitcast;
                }
                output_param (CB_VALUE (l), i);
                nolitcast = 0;
                i++;
                if (CB_CHAIN (l)) {
                    output (", ");
                }
            }
        } else {
            if (p->argv[i] && CB_LITERAL_P (p->argv[i])) {
                nolitcast = p->nolitcast;
            }
            output_param (p->argv[i], i);
            nolitcast = 0;
            if (i + 1 < p->argc) {
                output (", ");
            }
        }
    }
    output (")");
    nolitcast = 0;
    screenptr = 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_funcall_debug ( cb_tree  x )

static

Definition at line 4071 of file codegen.c.

References cb_funcall::argc, cb_funcall::argv, cb_build_debug(), CB_CHAIN, cb_debug_contents, cb_debug_name, CB_FUNCALL, CB_REF_OR_FIELD_P, CB_VALUE, cb_funcall::name, NULL, output_param(), output_perform_call(), output_stmt(), and cb_funcall::varcnt.

Referenced by output_cond_debug().

{
    struct cb_funcall   *p;
    cb_tree         l;
    cb_tree         z;
    int         i;

    p = CB_FUNCALL (x);
    if (p->name[0] == '$') {
        z = p->argv[0];
        if (CB_REF_OR_FIELD_P (z) &&
            cb_code_field (z)->flag_field_debug) {
            /* DEBUG */
            output_stmt (cb_build_debug (cb_debug_name,
                     (const char *)cb_code_field (z)->name, NULL));
            output_stmt (cb_build_debug (cb_debug_contents,
                             NULL, z));
            output_perform_call (cb_code_field (z)->debug_section,
                         cb_code_field (z)->debug_section);
        }
        z = p->argv[1];
        if (CB_REF_OR_FIELD_P (z) &&
            cb_code_field (z)->flag_field_debug) {
            /* DEBUG */
            output_stmt (cb_build_debug (cb_debug_name,
                     (const char *)cb_code_field (z)->name, NULL));
            output_stmt (cb_build_debug (cb_debug_contents,
                             NULL, z));
            output_perform_call (cb_code_field (z)->debug_section,
                         cb_code_field (z)->debug_section);
        }
        return;
    }
    for (i = 0; i < p->argc; i++) {
        if (p->varcnt && i + 1 == p->argc) {
            for (l = p->argv[i]; l; l = CB_CHAIN (l)) {
                output_param (CB_VALUE (l), i);
                z = CB_VALUE (l);
                if (CB_REF_OR_FIELD_P (z) &&
                    cb_code_field (z)->flag_field_debug) {
                    /* DEBUG */
                    output_stmt (cb_build_debug (cb_debug_name,
                             (const char *)cb_code_field (z)->name, NULL));
                    output_stmt (cb_build_debug (cb_debug_contents,
                                     NULL, z));
                    output_perform_call (cb_code_field (z)->debug_section,
                                 cb_code_field (z)->debug_section);
                }
                i++;
            }
        } else {
            z = p->argv[i];
            if (CB_REF_OR_FIELD_P (z) &&
                cb_code_field (z)->flag_field_debug) {
                /* DEBUG */
                output_stmt (cb_build_debug (cb_debug_name,
                         (const char *)cb_code_field (z)->name, NULL));
                output_stmt (cb_build_debug (cb_debug_contents,
                                 NULL, z));
                output_perform_call (cb_code_field (z)->debug_section,
                             cb_code_field (z)->debug_section);
            }
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_goto ( struct cb_goto *  p )

static

Definition at line 4406 of file codegen.c.

References cb_build_cast_int(), cb_build_debug(), CB_CHAIN, cb_debug_contents, cb_debug_name, CB_FIELD, CB_FUNCTION_TYPE, cb_int1, cb_ref(), CB_VALUE, cb_field::debug_section, cb_goto::depending, cb_field::flag_all_debug, cb_program::flag_gen_debug, cb_field::name, needs_exit_prog, cb_program::nested_level, NULL, output(), output_goto_1(), output_indent(), output_indent_level, output_line(), output_param(), output_perform_call(), output_prefix(), output_stmt(), cb_program::prog_type, and cb_goto::target.

Referenced by output_stmt().

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

    i = 1;
    if (p->depending) {
        /* Check for debugging on the DEPENDING item */
        if (current_prog->flag_gen_debug) {
            f = CB_FIELD (cb_ref (p->depending));
            if (f->flag_all_debug) {
                output_stmt (cb_build_debug (cb_debug_name,
                         (const char *)f->name, NULL));
                output_stmt (cb_build_debug (cb_debug_contents,
                                 NULL, p->depending));
                output_perform_call (f->debug_section,
                             f->debug_section);
            }
        }
        output_prefix ();
        output ("switch (");
        output_param (cb_build_cast_int (p->depending), 0);
        output (")\n");
        output_indent ("{");
        for (l = p->target; l; l = CB_CHAIN (l)) {
            output_indent_level -= 2;
            output_line ("case %d:", i++);
            output_indent_level += 2;
            output_goto_1 (CB_VALUE (l));
        }
        output_indent ("}");
    } else if (p->target == NULL) {
        /* EXIT PROGRAM/FUNCTION */
        needs_exit_prog = 1;
        if (cb_flag_implicit_init || current_prog->nested_level ||
            current_prog->prog_type == CB_FUNCTION_TYPE) {
            output_line ("goto exit_program;");
        } else {
            /* Ignore if not a callee */
            output_line ("if (module->next)");
            output_line ("  goto exit_program;");
        }
    } else if (p->target == cb_int1) {
        needs_exit_prog = 1;
        output_line ("goto exit_program;");
    } else {
        output_goto_1 (p->target);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_goto_1 ( cb_tree  x )

static

Definition at line 4370 of file codegen.c.

References cb_program::all_procedure, cb_build_debug(), cb_debug_contents, cb_debug_name, CB_LABEL, CB_PREFIX_LABEL, cb_ref(), cb_space, cb_label::flag_alter, cb_label::flag_debugging_mode, cb_program::flag_gen_debug, cb_label::flag_real_label, cb_label::flag_section, cb_program::flag_segments, cb_label::id, last_segment, cb_label::name, cb_para_label::next, NULL, output_line(), output_move(), output_stmt(), cb_para_label::para, cb_label::para_label, cb_label::section, and cb_label::segment.

Referenced by output_goto().

{
    struct cb_label     *lb;
    struct cb_para_label    *p;

    lb = CB_LABEL (cb_ref (x));
    if (current_prog->flag_segments && last_segment != lb->segment) {
        /* Zap independent labels */
        if (lb->flag_section) {
            p = lb->para_label;
        } else if (lb->section) {
            p = lb->section->para_label;
        } else {
            p = NULL;
        }
        for (; p; p = p->next) {
            if (p->para->segment > 49 &&
                p->para->flag_alter) {
                output_line ("label_%s%d = 0;",
                         CB_PREFIX_LABEL, p->para->id);
            }
        }
    }

    /* Check for debugging on procedure */
    if (current_prog->flag_gen_debug && lb->flag_real_label &&
        (current_prog->all_procedure || lb->flag_debugging_mode)) {
        output_stmt (cb_build_debug (cb_debug_name,
                         (const char *)lb->name, NULL));
        output_move (cb_space, cb_debug_contents);
    }

    output_line ("goto %s%d;", CB_PREFIX_LABEL, lb->id);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_header ( FILE *  fp, const char *  locbuff, const struct cb_program *  cp  )

static

Definition at line 7424 of file codegen.c.

References cb_oc_build_stamp, cb_saveargc, cb_saveargv, cb_source_file, COB_TAR_DATE, cb_program::orig_program_id, PACKAGE_VERSION, and PATCH_LEVEL.

Referenced by codegen().

{
    int i;

    if (fp) {
        fprintf (fp, "/* Generated by           cobc %s.%d */\n",
             PACKAGE_VERSION, PATCH_LEVEL);
        fprintf (fp, "/* Generated from         %s */\n", cb_source_file);
        fprintf (fp, "/* Generated at           %s */\n", locbuff);
        fprintf (fp, "/* GnuCOBOL build date    %s */\n", cb_oc_build_stamp);
        fprintf (fp, "/* GnuCOBOL package date  %s */\n", COB_TAR_DATE);
        fprintf (fp, "/* Compile command        ");
        for (i = 0; i < cb_saveargc; i++) {
            fprintf (fp, "%s ", cb_saveargv[i]);
        }
        fprintf (fp, "*/\n\n");
        if (cp) {
            fprintf (fp, "/* Program local variables for '%s' */\n\n",
                 cp->orig_program_id);
        }
    }
}

Here is the caller graph for this function:

static void output_indent ( const char *  str )

static

Definition at line 467 of file codegen.c.

References output_indent_level, and output_line().

Referenced by output_alter_check(), output_call(), output_class_name_definition(), output_error_handler(), output_ferror_stmt(), output_file_initialization(), output_goto(), output_initialize(), output_initialize_compound(), output_initialize_literal(), output_initialize_one(), output_internal_function(), output_main_function(), output_perform(), output_perform_until(), output_search_all(), output_search_whens(), and output_stmt().

{
    const char  *p;
    int     level;

    level = 2;
    for (p = str; *p == ' '; p++) {
        level++;
    }

    if (*p == '}' && strcmp (str, "})") != 0) {
        output_indent_level -= level;
    }

    output_line (str);

    if (*p == '{' && strcmp (str, ")}") != 0) {
        output_indent_level += level;
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_index ( cb_tree  x )

static

Definition at line 1608 of file codegen.c.

References cb_get_int(), CB_INTEGER, CB_TAG_INTEGER, CB_TAG_LITERAL, CB_TREE_TAG, output(), and output_integer().

Referenced by output_data(), and output_size().

{
    switch (CB_TREE_TAG (x)) {
    case CB_TAG_INTEGER:
        output ("%d", CB_INTEGER (x)->val - 1);
        break;
    case CB_TAG_LITERAL:
        output ("%d", cb_get_int (x) - 1);
        break;
    default:
        output ("(");
        output_integer (x);
        output (" - 1)");
        break;
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initial_values ( struct cb_field *  f )

static

Definition at line 5616 of file codegen.c.

References cb_build_field_reference(), cb_build_initialize(), cb_true, cb_field::count, cb_field::flag_item_based, cb_field::flag_no_init, NULL, output_stmt(), and cb_field::sister.

Referenced by output_internal_function().

{
    struct cb_field *p;
    cb_tree     x;

    for (p = f; p; p = p->sister) {
        x = cb_build_field_reference (p, NULL);
        if (p->flag_item_based) {
            continue;
        }
        /* For special registers */
        if (p->flag_no_init && !p->count) {
            continue;
        }
        output_stmt (cb_build_initialize (x, cb_true, NULL, 1, 0, 0));
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initialize ( struct cb_initialize *  p )

static

Definition at line 2831 of file codegen.c.

References CB_BUILD_CHAIN, cb_build_field_reference(), CB_CHAIN, cb_i, CB_REFERENCE, cb_initialize::flag_init_statement, cb_field::flag_occurs, i_counters, INITIALIZE_COMPOUND, INITIALIZE_DEFAULT, INITIALIZE_NONE, INITIALIZE_ONE, initialize_type(), initialize_uniform_char(), cb_field::level, NULL, cb_field::occurs_max, output_indent(), output_initialize_compound(), output_initialize_one(), output_initialize_uniform(), output_line(), cb_field::size, and cb_initialize::var.

Referenced by output_stmt().

{
    struct cb_field     *f;
    cb_tree         x;
    int         c;
    int         type;

    f = cb_code_field (p->var);
    type = initialize_type (p, f, 1);
    /* Check for non-standard OCCURS */
    if ((f->level == 1 || f->level == 77) &&
        f->flag_occurs && !p->flag_init_statement) {
        switch (type) {
        case INITIALIZE_NONE:
            return;
        case INITIALIZE_ONE:
            output_initialize_one (p, p->var);
            return;
        case INITIALIZE_DEFAULT:
            c = initialize_uniform_char (f, p);
            if (c != -1) {
                output_initialize_uniform (p->var, c, f->occurs_max);
                return;
            }
            /* Fall through */
        case INITIALIZE_COMPOUND:
            i_counters[0] = 1;
            output_line ("for (i0 = 1; i0 <= %d; i0++)", f->occurs_max);
            output_indent ("{");
            x = cb_build_field_reference (f, NULL);
            CB_REFERENCE (x)->subs =
                CB_BUILD_CHAIN (cb_i[0], CB_REFERENCE (x)->subs);
            output_initialize_compound (p, x);
            CB_REFERENCE (x)->subs =
                CB_CHAIN (CB_REFERENCE (x)->subs);
            output_indent ("}");
            return;
        default:
            break;
        }
    }
    switch (type) {
    case INITIALIZE_NONE:
        return;
    case INITIALIZE_ONE:
        output_initialize_one (p, p->var);
        return;
    case INITIALIZE_DEFAULT:
        c = initialize_uniform_char (f, p);
        if (c != -1) {
            output_initialize_uniform (p->var, c, f->size);
            return;
        }
        /* Fall through */
    case INITIALIZE_COMPOUND:
        output_initialize_compound (p, p->var);
        return;
    default:
        break;
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initialize_compound ( struct cb_initialize *  p, cb_tree  x  )

static

Definition at line 2754 of file codegen.c.

References CB_BUILD_CHAIN, cb_build_field_reference(), CB_CHAIN, cb_i, cb_int1, CB_REFERENCE, cb_field::children, cb_field::flag_occurs, i_counters, cb_field::indexes, INITIALIZE_DEFAULT, INITIALIZE_NONE, INITIALIZE_ONE, initialize_type(), initialize_uniform_char(), cb_field::occurs_max, cb_field::offset, output_indent(), output_initialize_one(), output_initialize_uniform(), output_line(), cb_field::redefines, cb_field::sister, and cb_field::size.

Referenced by output_initialize().

{
    struct cb_field *ff;
    struct cb_field *f;
    struct cb_field *last_field;
    cb_tree     c;
    size_t      size;
    int     type;
    int     last_char;
    int     i;

    ff = cb_code_field (x);
    for (f = ff->children; f; f = f->sister) {
        type = initialize_type (p, f, 0);
        c = cb_build_field_reference (f, x);

        switch (type) {
        case INITIALIZE_NONE:
            break;
        case INITIALIZE_DEFAULT:
            last_field = f;
            last_char = initialize_uniform_char (f, p);

            if (last_char != -1) {
                if (f->flag_occurs) {
                    CB_REFERENCE (c)->subs =
                        CB_BUILD_CHAIN (cb_int1,
                              CB_REFERENCE (c)->subs);
                }

                for (; f->sister; f = f->sister) {
                    if (!f->sister->redefines) {
                        if (initialize_type (p, f->sister, 0) != INITIALIZE_DEFAULT ||
                            initialize_uniform_char (f->sister, p) != last_char) {
                            break;
                        }
                    }
                }

                if (f->sister) {
                    size = f->sister->offset - last_field->offset;
                } else {
                    size = ff->offset + ff->size - last_field->offset;
                }

                output_initialize_uniform (c, last_char, (int) size);
                break;
            }
            /* Fall through */
        default:
            if (f->flag_occurs) {
                /* Begin occurs loop */
                i = f->indexes;
                i_counters[i] = 1;
                output_line ("for (i%d = 1; i%d <= %d; i%d++)",
                         i, i, f->occurs_max, i);
                output_indent ("{");
                CB_REFERENCE (c)->subs =
                    CB_BUILD_CHAIN (cb_i[i], CB_REFERENCE (c)->subs);
            }

            if (type == INITIALIZE_ONE) {
                output_initialize_one (p, c);
            } else {
                output_initialize_compound (p, c);
            }

            if (f->flag_occurs) {
                /* Close loop */
                CB_REFERENCE (c)->subs = CB_CHAIN (CB_REFERENCE (c)->subs);
                output_indent ("}");
            }
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initialize_fp ( cb_tree  x, struct cb_field *  f  )

static

Definition at line 2469 of file codegen.c.

References CB_USAGE_FLOAT, output(), output_data(), output_prefix(), and cb_field::usage.

Referenced by output_initialize_one().

{
    output_prefix ();
    if (f->usage == CB_USAGE_FLOAT) {
        output ("{float temp = 0.0;");
    } else {
        output ("{double temp = 0.0;");
    }
    output (" memcpy (");
    output_data (x);
    output (", (void *)&temp, sizeof(temp));}\n");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initialize_fp_bindec ( cb_tree  x, struct cb_field *  f  )

static

Definition at line 2460 of file codegen.c.

References output(), output_data(), output_prefix(), and cb_field::size.

Referenced by output_initialize_one().

{
    output_prefix ();
    output ("memset (");
    output_data (x);
    output (", 0, %d);\n", (int)f->size);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initialize_literal ( cb_tree  x, struct cb_field *  f, struct cb_literal *  l, const int  init_occurs  )

static

Definition at line 2395 of file codegen.c.

References CB_REFERENCE, CB_REFERENCE_P, cb_literal::data, i_counters, cb_literal::llit, cb_field::occurs_max, output(), output_data(), output_indent(), output_line(), output_prefix(), output_size(), output_string(), cb_literal::size, and cb_field::size.

Referenced by output_initialize_one().

{
    int i;
    int n;
    int size;
    int lsize;

    /* Check for non-standard 01 OCCURS */
    if (init_occurs) {
        size = f->occurs_max;
        lsize = (int)l->size;
        /* Check truncated literal */
        if (lsize > f->size) {
            lsize = f->size;
        }
    } else {
        size = f->size;
        lsize = (int)l->size;
    }
    if (lsize == 1) {
        output_prefix ();
        output ("memset (");
        output_data (x);
        if (CB_REFERENCE_P(x) && CB_REFERENCE(x)->length) {
            output (", %d, ", l->data[0]);
            output_size (x);
            output (");\n");
        } else {
            output (", %d, %d);\n", l->data[0], size);
        }
        return;
    }
    if (lsize >= size) {
        output_prefix ();
        output ("memcpy (");
        output_data (x);
        output (", ");
        output_string (l->data, size, l->llit);
        output (", %d);\n", size);
        return;
    }
    i = size / lsize;
    i_counters[0] = 1;
    output_line ("for (i0 = 0; i0 < %d; i0++)", i);
    output_indent ("{");
    output_prefix ();
    output ("memcpy (");
    output_data (x);
    output (" + (i0 * %d), ", lsize);
    output_string (l->data, lsize, l->llit);
    output (", %d);\n", lsize);
    output_indent ("}");
    n = size % lsize;
    if (n) {
        output_prefix ();
        output ("memcpy (");
        output_data (x);
        output (" + (i0 * %d), ", lsize);
        output_string (l->data, n, l->llit);
        output (", %d);\n", n);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initialize_one ( struct cb_initialize *  p, cb_tree  x  )

static

Definition at line 2504 of file codegen.c.

References _, cb_literal::all, CB_BUILD_CHAIN, CB_CATEGORY_ALPHANUMERIC_EDITED, CB_CATEGORY_NATIONAL, CB_CATEGORY_NATIONAL_EDITED, CB_CATEGORY_NUMERIC, CB_CATEGORY_NUMERIC_EDITED, CB_CHAIN, CB_CLASS_NUMERIC, CB_CONST_P, cb_high, cb_i, CB_LITERAL, CB_LITERAL_P, cb_low, cb_null, CB_PURPOSE_INT, cb_quote, CB_REFERENCE, cb_space, CB_TREE_CATEGORY, CB_TREE_CLASS, CB_USAGE_DISPLAY, CB_USAGE_DOUBLE, CB_USAGE_FLOAT, CB_USAGE_FP_BIN128, CB_USAGE_FP_BIN32, CB_USAGE_FP_BIN64, CB_USAGE_FP_DEC128, CB_USAGE_FP_DEC64, CB_USAGE_LONG_DOUBLE, CB_VALUE, cb_zero, cb_field::children, cob_u32_t, COBC_ABORT, cobc_abort_pr(), cobc_main_malloc(), cobc_main_realloc(), cb_literal::data, cb_field::flag_blank_zero, cb_field::flag_chained, cb_initialize::flag_default, cb_initialize::flag_init_statement, cb_field::flag_occurs, cb_field::flag_sign_separate, i_counters, cb_field::level, litbuff, litsize, cb_literal::llit, cb_field::occurs_max, output(), output_data(), output_figurative(), output_indent(), output_initialize_fp(), output_initialize_fp_bindec(), output_initialize_literal(), output_line(), output_move(), output_prefix(), output_string(), cb_field::param_num, cb_initialize::rep, cb_literal::size, cb_field::size, cb_field::usage, cb_initialize::val, value, and cb_field::values.

Referenced by output_initialize(), and output_initialize_compound().

{
    struct cb_field     *f;
    cb_tree         value;
    cb_tree         lrp;
    struct cb_literal   *l;
    size_t          lsize;
    cob_u32_t       inci;
    int         i;
    int         n;
    int         size;
    int         offset;
    int         init_occurs;
    unsigned char       buffchar;

    f = cb_code_field (x);

    /* CHAINING */
    if (f->flag_chained) {
        output_prefix ();
        output ("cob_chain_setup (");
        output_data (x);
        output (", %d, %d);\n", f->param_num, f->size);
        return;
    }
    /* Initialize by value */
    if (p->val && f->values) {
        value = CB_VALUE (f->values);
        /* Check for non-standard OCCURS */
        if ((f->level == 1 || f->level == 77) &&
            f->flag_occurs && !p->flag_init_statement) {
            init_occurs = 1;
        } else {
            init_occurs = 0;
        }
        if (value == cb_space) {
            output_figurative (x, f, ' ', init_occurs);
            return;
        } else if (value == cb_low) {
            output_figurative (x, f, 0, init_occurs);
            return;
        } else if (value == cb_high) {
            output_figurative (x, f, 255, init_occurs);
            return;
        } else if (value == cb_quote) {
            if (cb_flag_apostrophe) {
                output_figurative (x, f, '\'', init_occurs);
            } else {
                output_figurative (x, f, '"', init_occurs);
            }
            return;
        } else if (value == cb_zero && f->usage == CB_USAGE_DISPLAY) {
            if (!f->flag_sign_separate && !f->flag_blank_zero) {
                output_figurative (x, f, '0', init_occurs);
            } else {
                output_move (cb_zero, x);
            }
            return;
        } else if (value == cb_null && f->usage == CB_USAGE_DISPLAY) {
            output_figurative (x, f, 0, init_occurs);
            return;
        } else if (CB_LITERAL_P (value) && CB_LITERAL (value)->all) {
            /* ALL literal */
            output_initialize_literal (x, f,
                           CB_LITERAL (value), init_occurs);
            return;
        } else if (CB_CONST_P (value) ||
               CB_TREE_CLASS (value) == CB_CLASS_NUMERIC) {
            /* Figurative literal, numeric literal */
            /* Check for non-standard 01 OCCURS */
            if (init_occurs) {
                i_counters[0] = 1;
                output_line ("for (i0 = 1; i0 <= %d; i0++)",
                         f->occurs_max);
                output_indent ("{");
                CB_REFERENCE (x)->subs =
                    CB_BUILD_CHAIN (cb_i[0], CB_REFERENCE (x)->subs);
                output_move (value, x);
                CB_REFERENCE (x)->subs =
                    CB_CHAIN (CB_REFERENCE (x)->subs);
                output_indent ("}");
            } else {
                output_move (value, x);
            }
            return;
        }
        /* Alphanumeric literal */
        /* We do not use output_move here because
           we do not want to have the value be edited. */

        l = CB_LITERAL (value);

        /* Check for non-standard 01 OCCURS */
        if (init_occurs) {
            output_initialize_literal (x, f, l, 1);
            return;
        }

        size = f->size;

        if (size == 1) {
            output_prefix ();
            output ("*(cob_u8_ptr)(");
            output_data (x);
            output (") = %u;\n", l->data[0]);
            return;
        }

        buffchar = l->data[0];
        for (lsize = 0; lsize < l->size; lsize++) {
            if (l->data[lsize] != buffchar) {
                break;
            }
        }
        if (lsize == l->size) {
            output_prefix ();
            output ("memset (");
            output_data (x);
            output (", %u, %d);\n", (unsigned int)buffchar,
                (int)lsize);
            if ((int)l->size < (int)size) {
                output_prefix ();
                output ("memset (");
                output_data (x);
                output (" + %d, ' ', %d);\n",
                    (int)lsize, (int)(size - lsize));
            }
            return;
        }

        if (size > litsize) {
            litsize = size + 128;
            if (litbuff) {
                litbuff = cobc_main_realloc (litbuff, (size_t)litsize);
            } else {
                litbuff = cobc_main_malloc ((size_t)litsize);
            }
        }

        if ((int)l->size >= (int)size) {
            memcpy (litbuff, l->data, (size_t)size);
        } else {
            memcpy (litbuff, l->data, (size_t)l->size);
            memset (litbuff + l->size, ' ', (size_t)(size - l->size));
        }

        buffchar = *(litbuff + size - 1);
        n = 0;
        for (i = size - 1; i >= 0; i--, n++) {
            if (*(litbuff + i) != buffchar) {
                break;
            }
        }
        if (i < 0) {
            output_prefix ();
            output ("memset (");
            output_data (x);
            output (", %u, %d);\n", (unsigned int)buffchar, size);
            return;
        }

        if (n > 2) {
            offset = size - n;
            size -= n;
        } else {
            offset = 0;
        }

        inci = 0;
        for (; size > 509; size -= 509, inci += 509) {
            output_prefix ();
            output ("memcpy (");
            output_data (x);
            if (!inci) {
                output (", ");
            } else {
                output (" + %u, ", inci);
            }
            output_string (litbuff + inci, 509, l->llit);
            output (", 509);\n");
        }

        output_prefix ();
        output ("memcpy (");
        output_data (x);
        if (!inci) {
            output (", ");
        } else {
            output (" + %u, ", inci);
        }
        output_string (litbuff + inci, size, l->llit);
        output (", %d);\n", size);

        if (offset) {
            output_prefix ();
            output ("memset (");
            output_data (x);
            output (" + %d, %u, %d);\n",
                offset, (unsigned int)buffchar, n);
        }
        return;
    }

    /* Initialize replacing */
    if (!f->children) {
        for (lrp = p->rep; lrp; lrp = CB_CHAIN (lrp)) {
            if ((int)CB_PURPOSE_INT (lrp) == (int)CB_TREE_CATEGORY (x)) {
                output_move (CB_VALUE (lrp), x);
                return;
            }
        }
    }

    /* Initialize by default */
    if (p->flag_default) {
        switch (f->usage) {
        case CB_USAGE_FLOAT:
        case CB_USAGE_DOUBLE:
        case CB_USAGE_LONG_DOUBLE:
            output_initialize_fp (x, f);
            return;
        case CB_USAGE_FP_BIN32:
        case CB_USAGE_FP_BIN64:
        case CB_USAGE_FP_BIN128:
        case CB_USAGE_FP_DEC64:
        case CB_USAGE_FP_DEC128:
            output_initialize_fp_bindec (x, f);
            return;
        default:
            break;
        }
        switch (CB_TREE_CATEGORY (x)) {
        case CB_CATEGORY_NUMERIC:
        case CB_CATEGORY_NUMERIC_EDITED:
            output_move (cb_zero, x);
            break;
        case CB_CATEGORY_ALPHANUMERIC_EDITED:
        case CB_CATEGORY_NATIONAL:
        case CB_CATEGORY_NATIONAL_EDITED:
            output_move (cb_space, x);
            break;
        default:
            cobc_abort_pr (_("Unexpected tree category %d"),
                 (int)CB_TREE_CATEGORY (x));
            COBC_ABORT ();
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_initialize_uniform ( cb_tree  x, const int  c, const int  size  )

static

Definition at line 2483 of file codegen.c.

References CB_REFERENCE, CB_REFERENCE_P, output(), output_data(), output_prefix(), and output_size().

Referenced by output_initialize(), and output_initialize_compound().

{
    output_prefix ();
    if (size == 1) {
        output ("*(cob_u8_ptr)(");
        output_data (x);
        output (") = %d;\n", c);
    } else {
        output ("memset (");
        output_data (x);
        if (CB_REFERENCE_P(x) && CB_REFERENCE(x)->length) {
            output (", %d, ", c);
            output_size (x);
            output (");\n");
        } else {
            output (", %d, %d);\n", c, size);
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_integer ( cb_tree  x )

static

Definition at line 1101 of file codegen.c.

References _, cb_cast::cast_type, CB_BINARY_OP, CB_CAST, CB_CAST_ADDRESS, CB_CAST_PROGRAM_POINTER, CB_CONST, cb_fits_int(), cb_get_int(), CB_INTEGER, cb_null, CB_PREFIX_BASE, CB_STORAGE_LINKAGE, CB_TAG_BINARY_OP, CB_TAG_CAST, CB_TAG_CONST, CB_TAG_INTEGER, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_TAG, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_X, CB_USAGE_DISPLAY, CB_USAGE_INDEX, CB_USAGE_LENGTH, CB_USAGE_PACKED, CB_USAGE_POINTER, CB_USAGE_PROGRAM_POINTER, cb_zero, COB_GET_NUMDISP, COB_GET_PACKED_INT, COBC_ABORT, cobc_abort_pr(), cb_picture::digits, cb_binary_op::flag, cb_field::flag_binary_swap, gen_nested_tab, cb_picture::have_sign, hexval, cb_field::id, cb_field::indexes, cb_program::nested_prog_list, cb_field::offset, cb_binary_op::op, optimize_defs, output(), output_base(), output_data(), output_func_1(), output_param(), cb_field::pic, cb_picture::scale, cb_field::size, cb_field::special_index, cb_field::storage, cb_field::usage, cb_cast::val, cb_binary_op::x, and cb_binary_op::y.

Referenced by output_base(), output_call(), output_call_by_value_args(), output_cond(), output_data(), output_index(), output_internal_function(), output_occurs(), output_param(), output_search_all(), output_search_whens(), output_size(), and output_stmt().

{
    struct cb_binary_op *p;
    struct cb_cast      *cp;
    struct cb_field     *f;

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_CONST:
        if (x == cb_zero) {
            output ("0");
        } else if (x == cb_null) {
            output ("(cob_u8_ptr)NULL");
        } else {
            output ("%s", CB_CONST (x)->val);
        }
        break;
    case CB_TAG_INTEGER:
        if (CB_INTEGER (x)->hexval) {
            output ("0x%X", CB_INTEGER (x)->val);
        } else {
            output ("%d", CB_INTEGER (x)->val);
        }
        break;
    case CB_TAG_LITERAL:
        output ("%d", cb_get_int (x));
        break;
    case CB_TAG_BINARY_OP:
        p = CB_BINARY_OP (x);
        if (p->flag) {
            if (!cb_fits_int (p->x) || !cb_fits_int (p->y)) {
                output ("cob_get_int (");
                output_param (x, -1);
                output (")");
                break;
            }
        }
        if (p->op == '^') {
            output ("(int) pow (");
            output_integer (p->x);
            output (", ");
            output_integer (p->y);
            output (")");
        } else {
            output ("(");
            output_integer (p->x);
            output (" %c ", p->op);
            output_integer (p->y);
            output (")");
        }
        break;
    case CB_TAG_CAST:
        cp = CB_CAST (x);
        switch (cp->cast_type) {
        case CB_CAST_ADDRESS:
            output ("(");
            output_data (cp->val);
            output (")");
            break;
        case CB_CAST_PROGRAM_POINTER:
            output ("cob_call_field (");
            output_param (x, -1);
            if (current_prog->nested_prog_list) {
                gen_nested_tab = 1;
                output (", cob_nest_tab, 0, %d)", cb_fold_call);
            } else {
                output (", NULL, 0, %d)", cb_fold_call);
            }
            break;
        default:
            cobc_abort_pr (_("Unexpected cast type %d"),
                 (int)cp->cast_type);
            COBC_ABORT ();
        }
        break;
    case CB_TAG_REFERENCE:
        f = cb_code_field (x);
        switch (f->usage) {
        case CB_USAGE_INDEX:
            if (f->special_index) {
                output_base (f, 1U);
                output ("%s%d", CB_PREFIX_BASE, f->id);
                return;
            }
            /* Fall through */
        case CB_USAGE_LENGTH:
            output ("(*(int *) (");
            output_data (x);
            output ("))");
            return;

        case CB_USAGE_POINTER:
#ifdef  COB_NON_ALIGNED
            output ("(cob_get_pointer (");
            output_data (x);
            output ("))");
#else
            output ("(*(unsigned char **) (");
            output_data (x);
            output ("))");
#endif
            return;

        case CB_USAGE_PROGRAM_POINTER:
#ifdef  COB_NON_ALIGNED
            output ("(cob_get_prog_pointer (");
            output_data (x);
            output ("))");
#else
            output ("(*(unsigned char **) (");
            output_data (x);
            output ("))");
#endif
            return;

        case CB_USAGE_DISPLAY:
            if (f->pic && f->pic->scale >= 0 &&
                f->size - f->pic->scale > 0 &&
                f->size - f->pic->scale <= 9 &&
                f->pic->have_sign == 0 &&
                !cb_ebcdic_sign) {
                optimize_defs[COB_GET_NUMDISP] = 1;
                output ("cob_get_numdisp (");
                output_data (x);
                output (", %d)", f->size - f->pic->scale);
                return;
            }
            break;

        case CB_USAGE_PACKED:
            if (f->pic->scale == 0 && f->pic->digits < 10) {
                optimize_defs[COB_GET_PACKED_INT] = 1;
                output_func_1 ("cob_get_packed_int", x);
                return;
            }
            break;

        case CB_USAGE_BINARY:
        case CB_USAGE_COMP_5:
        case CB_USAGE_COMP_X:
            if (f->size == 1) {
                output ("(*(");
                if (!f->pic->have_sign) {
                    output ("cob_u8_ptr) (");
                } else {
                    output ("cob_s8_ptr) (");
                }
                output_data (x);
                output ("))");
                return;
            }
#ifdef  COB_NON_ALIGNED
            if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && (
#ifdef  COB_SHORT_BORK
                (f->size == 2 && (f->offset % 4 == 0)) ||
#else
                (f->size == 2 && (f->offset % 2 == 0)) ||
#endif
                (f->size == 4 && (f->offset % 4 == 0)) ||
                (f->size == 8 && (f->offset % 8 == 0)))) {
#else
            if (f->size == 2 || f->size == 4 || f->size == 8) {
#endif
                if (f->flag_binary_swap) {
                    output ("((");
                    switch (f->size) {
                    case 2:
                        if (!f->pic->have_sign) {
                            output ("unsigned short)COB_BSWAP_16(");
                        } else {
                            output ("short)COB_BSWAP_16(");
                        }
                        break;
                    case 4:
                        if (!f->pic->have_sign) {
                            output ("unsigned int)COB_BSWAP_32(");
                        } else {
                            output ("int)COB_BSWAP_32(");
                        }
                        break;
                    case 8:
                        if (!f->pic->have_sign) {
                            output ("cob_u64_t)COB_BSWAP_64(");
                        } else {
                            output ("cob_s64_t)COB_BSWAP_64(");
                        }
                        break;
                    default:
                        break;
                    }
                    output ("*(");
                    switch (f->size) {
                    case 2:
                        output ("short *)(");
                        break;
                    case 4:
                        output ("int *)(");
                        break;
                    case 8:
                        output ("cob_s64_t *)(");
                        break;
                    default:
                        break;
                    }
                    output_data (x);
                    output (")))");
                    return;
                } else {
                    output ("(*(");
                    switch (f->size) {
                    case 2:
                        if (!f->pic->have_sign) {
                            output ("unsigned short *)(");
                        } else {
                            output ("short *)(");
                        }
                        break;
                    case 4:
                        if (!f->pic->have_sign) {
                            output ("unsigned int *)(");
                        } else {
                            output ("int *)(");
                        }
                        break;
                    case 8:
                        if (!f->pic->have_sign) {
                            output ("cob_u64_ptr)(");
                        } else {
                            output ("cob_s64_ptr)(");
                        }
                        break;
                    default:
                        break;
                    }
                    output_data (x);
                    output ("))");
                    return;
                }
            }
            if (f->pic->have_sign == 0) {
                output ("(unsigned int)");
            }
            break;

        default:
            break;
        }

        output_func_1 ("cob_get_int", x);
        break;
    case CB_TAG_INTRINSIC:
        output ("cob_get_int (");
        output_param (x, -1);
        output (")");
        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 output_internal_function ( struct cb_program *  prog, cb_tree  parameter_list  )

static

Definition at line 5793 of file codegen.c.

References _, cb_program::alphabet_name_list, cb_program::alter_gotos, label_list::call_num, call_list::callname, CB_ALPHABET_NAME, cb_program::cb_call_params, CB_CHAIN, CB_EXCEPTION_ENABLE, CB_FILE, CB_FUNCTION_TYPE, cb_int1, CB_LABEL, cb_list_length(), CB_PREFIX_BASE, CB_PREFIX_FIELD, CB_PREFIX_FILE, CB_PREFIX_KEYS, CB_PREFIX_LABEL, CB_PREFIX_STRING, CB_PROGRAM_TYPE, CB_PURPOSE, cb_program::cb_return_code, CB_USAGE_COMP_6, CB_USAGE_DISPLAY, CB_USAGE_PACKED, CB_VALUE, cb_program::classification, cb_file::cname, COB_EC_DATA_INCOMPATIBLE, COB_EC_PROGRAM_RECURSIVE_CALL, COB_MALLOC_ALIGN, COB_ORG_INDEXED, COB_ORG_RELATIVE, COB_ORG_SORT, COB_SET_SCREEN, cob_u32_t, COBC_ABORT, cobc_abort_pr(), cobc_flag_main, cobc_parse_malloc(), cb_field::count, base_list::curr_prog, cb_program::decimal_index_max, cb_field::ename, cb_program::entry_list, excp_current_program_id, cb_program::exec_list, base_list::f, cb_program::file_list, cb_field::flag_any_length, cb_field::flag_any_numeric, cb_program::flag_chained, cb_program::flag_debugging, cb_field::flag_external, cb_file::flag_external, cb_program::flag_gen_error, cb_program::flag_global_use, cb_program::flag_initial, cb_field::flag_is_global, cb_field::flag_is_returning, cb_field::flag_item_78, cb_field::flag_item_based, cb_field::flag_local_alloced, cb_field::flag_local_storage, cb_program::flag_main, cb_field::flag_no_init, cb_program::flag_recursive, cb_program::flag_segments, gen_dynamic, cb_program::global_list, globext_cache, cb_alter_id::goto_id, label_list::id, cb_field::id, cb_file::linage, cb_program::linkage_storage, cb_program::local_include, local_mem, local_filename::local_name, cb_program::local_storage, local_working_mem, lookup_string(), cb_program::max_call_param, cb_field::mem_offset, cb_field::memory_size, cb_field::name, needs_exit_prog, cb_program::nested_level, label_list::next, call_list::next, base_list::next, cb_alter_id::next, cb_program::next_program, non_nested_count, NULL, cb_program::num_proc_params, optimize_defs, cb_file::organization, cb_program::orig_program_id, output(), output_alphabet_name_definition(), output_base(), output_data(), output_error_handler(), output_file_allocation(), output_file_initialization(), output_indent(), output_initial_values(), output_integer(), output_line(), output_local(), output_module_init(), output_move(), output_newline(), output_param(), output_prefix(), output_screen_definition(), output_screen_init(), output_size(), output_stmt(), output_target, cb_program::parameter_list, cb_program::prog_type, cb_program::program_id, cb_field::redefines, cb_program::returning, cb_program::screen_storage, cb_field::sister, cb_field::size, string_buffer, cb_program::toplev_count, cb_field::usage, working_mem, and cb_program::working_storage.

Referenced by codegen().

{
    cb_tree         l;
    cb_tree         l2;
    struct cb_field     *f;
    struct cb_program   *next_prog;
    struct cb_file      *fl;
    char            *p;
    struct label_list   *pl;
    struct cb_alter_id  *cpl;
    struct call_list    *clp;
    struct base_list    *bl;
    FILE            *savetarget;
    const char      *s;
    int         i;
    cob_u32_t       inc;
    int         parmnum;
    int         seen;
    int         anyseen;

    /* Program function */
#if 0   /* RXWRXW USERFUNC */
    if (prog->prog_type == CB_FUNCTION_TYPE) {
        output ("static cob_field *\n%s_ (const int entry, cob_field **cob_parms",
            prog->program_id);
#else
    if (prog->prog_type == CB_FUNCTION_TYPE) {
        output ("static cob_field *\n%s_ (const int entry",
            prog->program_id);
#endif
    } else if (!prog->nested_level) {
        output ("static int\n%s_ (const int entry",
            prog->program_id);
    } else {
        output ("static int\n%s_%d_ (const int entry",
            prog->program_id, prog->toplev_count);
    }
    parmnum = 0;
#if 0   /* RXWRXW USERFUNC */
    if (!prog->flag_chained && prog->prog_type != CB_FUNCTION_TYPE) {
#else
    if (!prog->flag_chained) {
#endif
        for (l = parameter_list; l; l = CB_CHAIN (l)) {
            if (l == parameter_list) {
                output (", ");
            }
            if (parmnum && !(parmnum % 2)) {
                output ("\n\t");
            }
            output ("cob_u8_t *%s%d",
                CB_PREFIX_BASE, cb_code_field (CB_VALUE (l))->id);
            if (CB_CHAIN (l)) {
                output (", ");
            }
            parmnum++;
        }
    }
    output (")\n");
    output_indent ("{");

    /* Program local variables */
    output_line ("/* Program local variables */");
    output_line ("#include \"%s\"", prog->local_include->local_name);
    output_newline ();

    /* Alphabet-names */
    if (prog->alphabet_name_list) {
        for (l = prog->alphabet_name_list; l; l = CB_CHAIN (l)) {
            output_alphabet_name_definition (CB_ALPHABET_NAME (CB_VALUE (l)));
        }
    }

    /* Module initialization indicator */
    output_local ("/* Module initialization indicator */\n");
    output_local ("static unsigned int\tinitialized = 0;\n\n");

    output_local ("/* Module structure pointer */\n");
#if 0   /* RXWRXW - MODULE */
    if (prog->flag_recursive) {
        output_local ("cob_module\t\t*module;\n\n");
    } else {
        output_local ("static cob_module\tmodule_data;\n");
        output_local ("static cob_module\t*module = &module_data;\n\n");
    }
#else
    if (prog->flag_recursive) {
        output_local ("cob_module\t\t*module = NULL;\n\n");
    } else {
        output_local ("static cob_module\t*module = NULL;\n\n");
    }
#endif

#if 1   /* RXWRXW - GLOBPTR */
    output_local ("/* Global variable pointer */\n");
    output_local ("cob_global\t\t*cob_glob_ptr;\n\n");
#endif

    /* Decimal structures */
    if (prog->decimal_index_max) {
        output_local ("/* Decimal structures */\n");
        for (i = 0; i < prog->decimal_index_max; i++) {
            output_local ("cob_decimal\t*d%d;\n", i);
        }
        output_local ("\n");
    }

    /* External items */
    seen = 0;
    for (f = prog->working_storage; f; f = f->sister) {
        if (f->flag_external) {
            if (f->flag_is_global) {
                bl = cobc_parse_malloc (sizeof (struct base_list));
                bl->f = f;
                bl->curr_prog = excp_current_program_id;
                bl->next = globext_cache;
                globext_cache = bl;
                continue;
            }
            if (!seen) {
                seen = 1;
                output_local ("/* EXTERNAL items */\n");
            }
            output_local ("static unsigned char\t*%s%d = NULL;",
                      CB_PREFIX_BASE, f->id);
            output_local ("  /* %s */\n", f->name);
        }
    }
    if (seen) {
        output_local ("\n");
    }
    for (l = prog->file_list; l; l = CB_CHAIN (l)) {
        f = CB_FILE (CB_VALUE (l))->record;
        if (f->flag_external) {
            if (f->flag_is_global) {
                bl = cobc_parse_malloc (sizeof (struct base_list));
                bl->f = f;
                bl->curr_prog = excp_current_program_id;
                bl->next = globext_cache;
                globext_cache = bl;
                continue;
            }
            output_local ("static unsigned char\t*%s%d = NULL;",
                      CB_PREFIX_BASE, f->id);
            output_local ("  /* %s */\n", f->name);
        }
    }

    /* Allocate files */
    if (prog->file_list) {
        i = 0;
        for (l = prog->file_list; l; l = CB_CHAIN (l)) {
            i += output_file_allocation (CB_FILE (CB_VALUE (l)));
        }
        if (i) {
            output_local ("\n/* LINAGE pointer */\n");
            output_local ("static cob_linage\t\t*lingptr;\n");
        }
    }

    /* BASED working-storage */
    i = 0;
    for (f = prog->working_storage; f; f = f->sister) {
        if (f->redefines) {
            continue;
        }
        if (f->flag_item_based) {
            if (!i) {
                i = 1;
                output_local("\n/* BASED WORKING-STORAGE SECTION */\n");
            }
            output_local ("static unsigned char\t*%s%d = NULL; /* %s */\n",
                CB_PREFIX_BASE, f->id, f->name);
        }
    }
    if (i) {
        output_local ("\n");
    }

    /* BASED local-storage */
    i = 0;
    for (f = prog->local_storage; f; f = f->sister) {
        if (f->redefines) {
            continue;
        }
        if (f->flag_item_based) {
            if (!i) {
                i = 1;
                output_local("\n/* BASED LOCAL-STORAGE */\n");
            }
            output_local ("static unsigned char\t*%s%d = NULL; /* %s */\n",
                CB_PREFIX_BASE, f->id, f->name);
        }
    }
    if (i) {
        output_local ("\n");
    }

#if 0   /* RXWRXW USERFUNC */
    if (prog->prog_type == CB_FUNCTION_TYPE) {
        /* USING parameters for user FUNCTION */
        seen = 0;
        for (l = parameter_list; l; l = CB_CHAIN (l)) {
            f = cb_code_field (CB_VALUE (l));
            if (!seen) {
                seen = 1;
                output_local ("\n/* USING parameters */\n");
            }
            output_local ("unsigned char\t*%s%d = NULL;  /* %s */\n",
                     CB_PREFIX_BASE, f->id, f->name);
        }
        if (seen) {
            output_local ("\n");
        }
    }
#endif

    /* Dangling linkage section items */
    seen = 0;
    for (f = prog->linkage_storage; f; f = f->sister) {
        if (f->redefines) {
            continue;
        }
        for (l = parameter_list; l; l = CB_CHAIN (l)) {
            if (f == cb_code_field (CB_VALUE (l))) {
                break;
            }
        }
        if (l == NULL) {
            if (!seen) {
                seen = 1;
                output_local ("\n/* LINKAGE SECTION (Items not referenced by USING clause) */\n");
            }
            if (!f->flag_is_returning) {
                output_local ("static ");
            }
            output_local ("unsigned char\t*%s%d = NULL;  /* %s */\n",
                     CB_PREFIX_BASE, f->id, f->name);
        }
    }
    if (seen) {
        output_local ("\n");
    }

    /* Screens */
    if (prog->screen_storage) {
        optimize_defs[COB_SET_SCREEN] = 1;
        output_local ("\n/* Screens */\n\n");
        output_screen_definition (prog->screen_storage);
        output_local ("\n");
    }

    /* ANY LENGTH items */
    i = 0;
    anyseen = 0;
    for (l = parameter_list; l; l = CB_CHAIN (l), i++) {
        f = cb_code_field (CB_VALUE (l));
        if (f->flag_any_length) {
            anyseen = 1;
#if 0   /* RXWRXW - Any */
            output_local ("/* ANY LENGTH variable */\n");
            output_local ("cob_field\t\t*cob_anylen;\n\n");
#endif
            break;
        }
    }

    /* Save variables for global callback */
    if (prog->flag_global_use && parameter_list) {
        output_local ("/* Parameter save */\n");
        for (l = parameter_list; l; l = CB_CHAIN (l)) {
            f = cb_code_field (CB_VALUE (l));
            output_local ("static unsigned char\t*save_%s%d;\n",
                CB_PREFIX_BASE, f->id);
        }
        output_local ("\n");
    }

    /* Runtime DEBUGGING MODE variable */
    if (prog->flag_debugging) {
        output_line ("char\t\t*s;");
        output_newline ();
    }

    /* Start of function proper */
    output_line ("/* Start of function code */");
    output_newline ();

    /* CANCEL callback */
    if (prog->prog_type == CB_PROGRAM_TYPE) {
        output_line ("/* CANCEL callback */");
        output_line ("if (unlikely(entry < 0)) {");
        output_line ("\tgoto P_cancel;");
        output_line ("}");
        output_newline ();
    }

#if 0   /* RXWRXW - MODULEALL */
    /* Recursive module initialization */
    if (prog->flag_recursive) {
        output_line ("/* Allocate cob_module structure */");
        output_line ("module = cob_malloc (sizeof(cob_module));");
        output_newline ();
    }
#endif


    output_line ("/* Check initialized, check module allocated, */");
    output_line ("/* set global pointer, */");
    output_line ("/* push module stack, save call parameter count */");
#if 0   /* RXWRXW - MODULEALL */
    output_line ("cob_module_enter (module, &cob_glob_ptr, %d);",
              cb_flag_implicit_init);
#else
    output_line ("cob_module_enter (&module, &cob_glob_ptr, %d);",
              cb_flag_implicit_init);
#endif
    output_newline ();

    /* Check INITIAL programms being non-recursive */
    if (CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_RECURSIVE_CALL)
        && prog->flag_initial) {
        output_line ("/* Check active count */");
        output_line ("if (unlikely(module->module_active)) {");
        /* FIXME: Should raise COB_EC_PROGRAM_RECURSIVE_CALL instead */
        output_line ("\tcob_fatal_error (COB_FERROR_RECURSIVE);");
        output_line ("}");
    }

    /* Recursive module initialization */
    if (prog->flag_recursive) {
        output_module_init (prog);
    }

    output_line ("/* Set address of module parameter list */");
    if (cb_flag_stack_on_heap || prog->flag_recursive) {
        if (prog->max_call_param) {
            i = prog->max_call_param;
        } else {
            i = 1;
        }
        output_line ("cob_procedure_params = cob_malloc (%dU * sizeof(void *));",
                 i);
    }
    output_line ("module->cob_procedure_params = cob_procedure_params;");
    output_newline ();

#if 0   /* RXWRXW USERFUNC */
    if (prog->prog_type == CB_FUNCTION_TYPE) {
        parmnum = 0;
        for (l = parameter_list; l; l = CB_CHAIN (l), parmnum++) {
            f = cb_code_field (CB_VALUE (l));
            output_line ("if (cob_parms[%d])", parmnum);
            output_line (" %s%d = cob_parms[%d]->data;",
                     CB_PREFIX_BASE, f->id, parmnum);
            output_line ("else");
            output_line (" %s%d = NULL;",
                     CB_PREFIX_BASE, f->id);
        }
        output_newline ();
    }
#endif

    output_line ("/* Set frame stack pointer */");
    if (cb_flag_stack_on_heap || prog->flag_recursive) {
        if (prog->flag_recursive && cb_stack_size == 255) {
            i = 63;
        } else {
            i = cb_stack_size;
        }
        output_line ("frame_stack = cob_malloc (%dU * sizeof(struct cob_frame));",
                 i);
        output_line ("frame_ptr = frame_stack;");
        if (cb_flag_stack_check) {
            output_line ("frame_overflow = frame_ptr + %d - 1;",
                     i);
        }
    } else {
        output_line ("frame_ptr = frame_stack;");
        output_line ("frame_ptr->perform_through = 0;");
        if (cb_flag_stack_check) {
            output_line ("frame_overflow = frame_ptr + %d - 1;",
                     cb_stack_size);
        }
    }
    output_newline ();

    /* Set up LOCAL-STORAGE size */
    if (prog->local_storage) {
        for (f = prog->local_storage; f; f = f->sister) {
            if (f->flag_item_based || f->flag_local_alloced) {
                continue;
            }
            if (f->redefines) {
                continue;
            }
            if (f->flag_item_78) {
                cobc_abort_pr (_("Unexpected CONSTANT item"));
                COBC_ABORT ();
            }
            f->flag_local_storage = 1;
            f->flag_local_alloced = 1;
            f->mem_offset = local_mem;
            /* Round up to COB_MALLOC_ALIGN + 1 bytes */
            /* Caters for current types */
            local_mem += ((f->memory_size + COB_MALLOC_ALIGN) &
                    ~COB_MALLOC_ALIGN);
        }
    }

    /* Initialization */

    /* Allocate and initialize LOCAL storage */
    if (prog->local_storage) {
        if (local_mem) {
            output_line ("/* Allocate LOCAL storage */");
            output_line ("cob_local_ptr = cob_malloc (%dU);",
                     local_mem);
            if (prog->flag_global_use) {
                output_line ("cob_local_save = cob_local_ptr;");
            }
        }
        output_newline ();
        output_line ("/* Initialize LOCAL storage */");
        output_initial_values (prog->local_storage);
        output_newline ();
    }

    output_line ("/* Initialize rest of program */");
    output_line ("if (unlikely(initialized == 0)) {");
    output_line ("\tgoto P_initialize;");
    if (prog->flag_chained) {
        output_line ("} else {");
        output_line ("\tcob_fatal_error (COB_FERROR_CHAINING);");
    }
    output_line ("}");
    output_line ("P_ret_initialize:");
    output_newline ();

    if (prog->decimal_index_max) {
        output_line ("/* Allocate decimal numbers */");
        output_prefix ();
        if (prog->flag_recursive) {
            output ("cob_decimal_push (%d", prog->decimal_index_max);
        } else {
            output ("cob_decimal_alloc (%d", prog->decimal_index_max);
        }
        for (i = 0; i < prog->decimal_index_max; i++) {
            output (", &d%d", i);
        }
        output (");\n");
        output_newline ();
    }

    /* Global entry dispatch */
    if (prog->global_list) {
        output_line ("/* Global entry dispatch */");
        output_newline ();
        for (l = prog->global_list; l; l = CB_CHAIN (l)) {
            output_line ("if (unlikely(entry == %d)) {",
                    CB_LABEL (CB_VALUE (l))->id);
            i = 0;
            if (local_mem) {
                output_line ("\tcob_local_ptr = cob_local_save;");
            }
            for (l2 = parameter_list; l2; l2 = CB_CHAIN (l2), i++) {
                f = cb_code_field (CB_VALUE (l2));
                output_line ("\t%s%d = save_%s%d;",
                    CB_PREFIX_BASE, f->id,
                    CB_PREFIX_BASE, f->id);
            }
            output_line ("\tgoto %s%d;",
                    CB_PREFIX_LABEL,
                    CB_LABEL (CB_VALUE (l))->id);
            output_line ("}");
        }
        output_newline ();
    }

    if (cb_flag_recursive && !prog->flag_recursive) {
        output_line ("/* Check active count */");
        output_line ("if (unlikely(module->module_active)) {");
        output_line ("\tcob_fatal_error (COB_FERROR_RECURSIVE);");
        output_line ("}");
    }
    if (!prog->flag_recursive) {
        output_line ("/* Increment module active */");
        output_line ("module->module_active++;");
        output_newline ();
    }

    if (!cobc_flag_main && non_nested_count > 1) {
        output_line ("/* Increment module reference count */");
        output_line ("cob_reference_count++;");
        output_newline ();
    }

    /* Initialize W/S and files unconditionally when INITIAL program */
    if (prog->flag_initial) {
        output_line ("/* Initialize INITIAL program WORKING-STORAGE */");
        output_initial_values (prog->working_storage);
        output_newline ();
        for (l = prog->file_list; l; l = CB_CHAIN (l)) {
            output_file_initialization (CB_FILE (CB_VALUE (l)));
        }
        output_newline ();
    }

    /* Call parameters */
    if (cb_code_field (prog->cb_call_params)->count) {
        output_line ("/* Set NUMBER-OF-CALL-PARAMETERS */");
        output_prefix ();
        output_integer (prog->cb_call_params);
        output (" = cob_glob_ptr->cob_call_params;\n");
        output_newline ();
    }

#if 1   /* RXWRXW - Save call params */
    output_line ("/* Save number of call params */");
    output_line ("module->module_num_params = cob_glob_ptr->cob_call_params;");
    output_newline ();
#endif

    /* Set up ANY length items */
    i = 0;
    if (anyseen) {
        output_line ("/* Initialize ANY LENGTH parameters */");
    }
    for (l = parameter_list; l; l = CB_CHAIN (l), i++) {
        f = cb_code_field (CB_VALUE (l));
        if (f->flag_any_length) {
            /* Force field cache */
            savetarget = output_target;
            output_target = NULL;
            output_param (CB_VALUE (l), i);
            output_target = savetarget;

            output_line ("if (cob_glob_ptr->cob_call_params > %d && %s%d%s)",
                i, "module->next->cob_procedure_params[",
                i, "]");
            if (f->flag_any_numeric) {
                /* Copy complete structure */
                output_line ("  %s%d = *(%s%d%s);",
                         CB_PREFIX_FIELD, f->id,
                         "module->next->cob_procedure_params[",
                         i, "]");
            } else {
                /* Copy size */
                output_line ("  %s%d.size = %s%d%s;",
                         CB_PREFIX_FIELD, f->id,
                         "module->next->cob_procedure_params[",
                         i, "]->size");
            }
            output_prefix ();
            output ("%s%d.data = ", CB_PREFIX_FIELD, f->id);
            output_data (CB_VALUE (l));
            output (";\n");
#if 0   /* RXWRXW - Num check */
            if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE) &&
                f->flag_any_numeric &&
                (f->usage == CB_USAGE_DISPLAY ||
                 f->usage == CB_USAGE_PACKED ||
                 f->usage == CB_USAGE_COMP_6)) {
                output_line ("cob_check_numeric (&%s%d, %s%d);",
                         CB_PREFIX_FIELD
                         f->id,
                         CB_PREFIX_STRING,
                         lookup_string (f->name));
            }
#endif
        }
    }
    if (anyseen) {
        output_newline ();
    }

    if (prog->prog_type == CB_FUNCTION_TYPE) {
        output_prefix ();
        output_data (prog->returning);
        output (" = cob_malloc (");
        output_size (prog->returning);
        output ("U);\n\n");
    }

    if (prog->flag_global_use && parameter_list) {
        output_line ("/* Parameter save */");
        for (l = parameter_list; l; l = CB_CHAIN (l)) {
            f = cb_code_field (CB_VALUE (l));
            output_line ("save_%s%d = %s%d;",
                CB_PREFIX_BASE, f->id,
                CB_PREFIX_BASE, f->id);
        }
        output_newline ();
    }

    /* Classification */
    if (prog->classification) {
        if (prog->classification == cb_int1) {
            output_line ("cob_set_locale (NULL, COB_LC_CLASS);");
        } else {
            output_prefix ();
            output ("cob_set_locale (");
            output_param  (prog->classification, -1);
            output (", COB_LC_CTYPE);");
        }
        output_newline ();
    }

    /* Entry dispatch */
    output_line ("/* Entry dispatch */");
    if (cb_list_length (prog->entry_list) > 1) {
        output_newline ();
        output_line ("switch (entry)");
        output_line ("  {");
        for (i = 0, l = prog->entry_list; l; l = CB_CHAIN (l)) {
            output_line ("  case %d:", i++);
            output_line ("    goto %s%d;", CB_PREFIX_LABEL,
                     CB_LABEL (CB_PURPOSE (l))->id);
        }
        output_line ("  }");
        output_line ("/* This should never be reached */");
        output_line ("cob_fatal_error (COB_FERROR_MODULE);");
        output_newline ();
    } else {
        l = prog->entry_list;
        output_line ("goto %s%d;", CB_PREFIX_LABEL,
                 CB_LABEL (CB_PURPOSE (l))->id);
        output_newline ();
    }

    /* PROCEDURE DIVISION */
    output_line ("/* PROCEDURE DIVISION */");
    for (l = prog->exec_list; l; l = CB_CHAIN (l)) {
        output_stmt (CB_VALUE (l));
    }
    output_newline ();

    /* End of program */
    output_line ("/* Program exit */");
    output_newline ();

    if (needs_exit_prog) {
        output_line ("exit_program:");
        output_newline ();
    }

    if (!prog->flag_recursive) {
        output_line ("/* Decrement module active count */");
        output_line ("if (module->module_active) {");
        output_line ("\tmodule->module_active--;");
        output_line ("}");
        output_newline ();
    }

    if (!cobc_flag_main && non_nested_count > 1) {
        output_line ("/* Decrement module reference count */");
        output_line ("if (cob_reference_count) {");
        output_line ("\tcob_reference_count--;");
        output_line ("}");
        output_newline ();
    }

    if (gen_dynamic) {
        output_line ("/* Deallocate dynamic FUNCTION-ID fields */");
        for (inc = 0; inc < gen_dynamic; inc++) {
            output_line ("if (cob_dyn_%u) {", inc);
            output_line ("  if (cob_dyn_%u->data) {", inc);
            output_line ("    cob_free (cob_dyn_%u->data);", inc);
            output_line ("  }");
            output_line ("  cob_free (cob_dyn_%u);", inc);
            output_line ("  cob_dyn_%u = NULL;", inc);
            output_line ("}");
        }
        output_newline ();
    }

    if (prog->local_storage) {
        output_line ("/* Deallocate LOCAL storage */");
        if (local_mem) {
            output_line ("if (cob_local_ptr) {");
            output_line ("\tfree (cob_local_ptr);");
            output_line ("\tcob_local_ptr = NULL;");
            if (current_prog->flag_global_use) {
                output_line ("\tcob_local_save = NULL;");
            }
            output_line ("}");
        }
        for (f = prog->local_storage; f; f = f->sister) {
            if (f->flag_item_based) {
                output_line ("if (%s%d) {", CB_PREFIX_BASE, f->id);
                output_line ("\tcob_free_alloc (&%s%d, NULL);",
                         CB_PREFIX_BASE, f->id);
                output_line ("\t%s%d = NULL;",
                         CB_PREFIX_BASE, f->id);
                output_line ("}");
            }
        }
        output_newline ();
    }

    if (prog->decimal_index_max && prog->flag_recursive) {
        output_line ("/* Free decimal structures */");
        output_prefix ();
        output ("cob_decimal_pop (%d", prog->decimal_index_max);
        for (i = 0; i < prog->decimal_index_max; i++) {
            output (", d%d", i);
        }
        output (");\n");
        output_newline ();
    }

    if (cb_flag_stack_on_heap || prog->flag_recursive) {
        output_line ("/* Free frame stack / call parameters */");
        output_line ("cob_free (frame_stack);");
        output_line ("cob_free (cob_procedure_params);");
        output_newline ();
    }

    if (cb_flag_trace) {
        output_line ("/* Trace program exit */");
        sprintf (string_buffer, "Exit:      %s", excp_current_program_id);
        output_line ("cob_trace_section (%s%d, NULL, 0);",
                 CB_PREFIX_STRING,
                 lookup_string (string_buffer));
        output_newline ();
    }

    output_line ("/* Pop module stack */");
    output_line ("cob_module_leave (module);");
    output_newline ();

    if (prog->flag_recursive) {
        output_line ("/* Free cob_module structure */");
        output_line ("cob_cache_free (module);");
        output_newline ();
    }

    /* Implicit CANCEL for INITIAL program */
    if (prog->flag_initial) {
        output_line ("/* CANCEL for INITIAL program */");
        output_prefix ();
        if (!prog->nested_level) {
            output ("%s_ (-1", prog->program_id);
        } else {
            output ("%s_%d_ (-1", prog->program_id,
                prog->toplev_count);
        }
        if (!prog->flag_chained) {
            for (l = parameter_list; l; l = CB_CHAIN (l)) {
                output (", NULL");
            }
        }
        output (");\n");
        output_newline ();
    }

    output_line ("/* Program return */");
#if 1   /* RXWRXW - PROCRET */
    if (prog->returning) {
        output_move (prog->returning, prog->cb_return_code);
    }
#endif
    output_prefix ();
    output ("return ");
    if (prog->prog_type == CB_FUNCTION_TYPE) {
        output_param (prog->returning, -1);
    } else {
        output_integer (prog->cb_return_code);
    }
    output (";\n");

    /* Error handlers */
    if (prog->file_list || prog->flag_gen_error) {
        output_error_handler (prog);
    }

    /* Frame stack jump table for compiler without computed goto */
    if (!cb_flag_computed_goto) {
        output_newline ();
        output_line ("/* Frame stack jump table */");
        output_line ("P_switch:");
        if (label_cache) {
            output_line (" switch (frame_ptr->return_address_num) {");
            for (pl = label_cache; pl; pl = pl->next) {
                output_line (" case %d:", pl->call_num);
                output_line ("   goto %s%d;", CB_PREFIX_LABEL,
                         pl->id);
            }
            output_line (" }");
        }
        output_line (" cob_fatal_error (COB_FERROR_CODEGEN);");
        output_newline ();
    }

    /* Program initialization */

#if 0   /* RXWRXW WS */
    if (prog->working_storage) {
        for (f = prog->working_storage; f; f = f->sister) {
            if (f->flag_item_based || f->flag_local_alloced) {
                continue;
            }
            if (f->redefines || f->flag_external) {
                continue;
            }
#if 0   /* RXWRXW - Check global */
            if (f->flag_is_global) {
                continue;
            }
#endif
            if (f->flag_no_init && !f->count) {
                continue;
            }
            if (f->flag_item_78) {
                cobc_abort_pr (_("Unexpected CONSTANT item"));
                COBC_ABORT ();
            }
            if (f->flag_is_global) {
                f->mem_offset = working_mem;
                working_mem += ((f->memory_size + COB_MALLOC_ALIGN) &
                        ~COB_MALLOC_ALIGN);
            } else {
                f->mem_offset = local_working_mem;
                local_working_mem += ((f->memory_size + COB_MALLOC_ALIGN) &
                        ~COB_MALLOC_ALIGN);
            }
        }
    }
#endif

    output_newline ();
    output_line ("/* Program initialization */");
    output_line ("P_initialize:");
    output_newline ();

    /* Check matching version */
    if (!prog->nested_level) {
        output_line ("cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL);");
        output_newline ();
    }

    /* Resolve user functions */
    for (clp = func_call_cache; clp; clp = clp->next) {
        output_line ("func_%s.funcvoid = cob_resolve_func (\"%s\");",
                  clp->callname, clp->callname);
    }

    if (cobc_flag_main && !prog->nested_level) {
        output_line ("cob_module_path = cob_glob_ptr->cob_main_argv0;");
        output_newline ();
    }

    /* Module initialization */
    if (!prog->flag_recursive) {
        output_module_init (prog);
    }


    /* Check runtime DEBUGGING MODE variable */
    if (prog->flag_debugging) {
        output_line ("if ((s = getenv (\"COB_SET_DEBUG\")) && (*s == 'Y' || *s == 'y' || *s == '1'))");
        output_line ("\tcob_debugging_mode = 1;");
        output_newline ();
    }

    /* Setup up CANCEL callback */
    if (!prog->nested_level && prog->prog_type == CB_PROGRAM_TYPE) {
        output_line ("/* Initialize cancel callback */");
#if 0   /* RXWRXW CA */
        if (!cb_flag_implicit_init) {
            output_line ("if (module->next)");
        }
#endif
        output_line ("cob_set_cancel (module);");
        output_newline ();
    }

    /* Initialize EXTERNAL files */
    for (l = prog->file_list; l; l = CB_CHAIN (l)) {
        f = CB_FILE (CB_VALUE (l))->record;
        if (f->flag_external) {
            strcpy (string_buffer, f->name);
            for (p = string_buffer; *p; p++) {
                if (*p == '-' || *p == ' ') {
                    *p = '_';
                }
            }
            output_line ("%s%d = cob_external_addr (\"%s\", %d);",
                     CB_PREFIX_BASE, f->id, string_buffer,
                     CB_FILE (CB_VALUE (l))->record_max);
        }
    }

    /* Initialize WORKING-STORAGE EXTERNAL items */
    for (f = prog->working_storage; f; f = f->sister) {
        if (f->redefines) {
            continue;
        }
        if (!f->flag_external) {
            continue;
        }
        output_prefix ();
        output_base (f, 0);
        output (" = cob_external_addr (\"%s\", %d);\n",
            f->ename, f->size);
    }

    /* Initialize WORKING-STORAGE/files if not INITIAL program */
    if (!prog->flag_initial) {
        if (prog->working_storage) {
            output_line ("/* Initialize WORKING-STORAGE */");
            output_initial_values (prog->working_storage);
            output_newline ();
        }
        if (prog->file_list) {
            output_newline ();
            for (l = prog->file_list; l; l = CB_CHAIN (l)) {
                output_file_initialization (CB_FILE (CB_VALUE (l)));
            }
            output_newline ();
        }
    }

    if (prog->screen_storage) {
        output_line ("/* Initialize SCREEN items */");
        /* Initialize items with VALUE */
        output_initial_values (prog->screen_storage);
        output_screen_init (prog->screen_storage, NULL);
        output_newline ();
    }

    output_line ("initialized = 1;");
    output_line ("goto P_ret_initialize;");

    /* Set up CANCEL callback code */

    if (prog->prog_type != CB_PROGRAM_TYPE) {
        goto prog_cancel_end;
    }

    output_newline ();
    output_line ("/* CANCEL callback handling */");
    output_line ("P_cancel:");
    output_newline ();
    output_line ("if (!initialized) {");
    output_line ("\treturn 0;");
    output_line ("}");
    output_line ("if (module->module_active) {");
    output_line ("\tcob_fatal_error (COB_FERROR_CANCEL);");
    output_line ("}");
    output_newline ();

    if (prog->flag_main) {
        goto cancel_end;
    }

    next_prog = prog->next_program;

    /* Check for implicit cancel of contained programs */
    for (; next_prog; next_prog = next_prog->next_program) {
        if (next_prog->nested_level == prog->nested_level + 1) {
            output_prefix ();
            output ("(void)%s_%d_ (-1", next_prog->program_id,
                next_prog->toplev_count);
            for (i = 0; i < next_prog->num_proc_params; ++i) {
                output (", NULL");
            }
            output (");\n");
        }
    }

    /* Close files on cancel */
    for (l = prog->file_list; l; l = CB_CHAIN (l)) {
        fl = CB_FILE (CB_VALUE (l));
        if (fl->organization != COB_ORG_SORT) {
            output_line ("cob_close (%s%s, NULL, COB_CLOSE_NORMAL, 1);",
                    CB_PREFIX_FILE, fl->cname);
            if (!fl->flag_external) {
                if (fl->linage) {
                    output_line ("cob_cache_free (%s%s->linorkeyptr);",
                             CB_PREFIX_FILE, fl->cname);
                }
                if (fl->organization == COB_ORG_RELATIVE ||
                    fl->organization == COB_ORG_INDEXED) {
                    output_line ("cob_cache_free (%s%s);",
                             CB_PREFIX_KEYS, fl->cname);
                    output_line ("%s%s = NULL;",
                             CB_PREFIX_KEYS, fl->cname);
                }
                output_line ("cob_cache_free (%s%s);",
                        CB_PREFIX_FILE, fl->cname);
                output_line ("%s%s = NULL;",
                        CB_PREFIX_FILE, fl->cname);
            }
        } else {
            output_line ("cob_cache_free (%s%s);",
                    CB_PREFIX_FILE, fl->cname);
            output_line ("%s%s = NULL;",
                    CB_PREFIX_FILE, fl->cname);
        }
    }

    /* Clear alter indicators */
    for (cpl = prog->alter_gotos; cpl; cpl = cpl->next) {
        output_line ("label_%s%d = 0;",
                 CB_PREFIX_LABEL, cpl->goto_id);
        if (prog->flag_segments) {
            output_line ("save_label_%s%d = 0;",
                     CB_PREFIX_LABEL, cpl->goto_id);
        }
    }

    /* Release based storage */
    for (f = prog->working_storage; f; f = f->sister) {
        if (f->flag_item_based) {
            output_line ("if (%s%d) {", CB_PREFIX_BASE, f->id);
            output_line ("\tcob_free_alloc (&%s%d, NULL);",
                     CB_PREFIX_BASE, f->id);
            output_line ("}");
        }
    }

    /* Reset DEBUGGING mode */
    if (prog->flag_debugging) {
        output_line ("cob_debugging_mode = 0;");
    }

    /* Clear CALL pointers */
    for (clp = call_cache; clp; clp = clp->next) {
        output_line ("call_%s.funcvoid = NULL;", clp->callname);
    }
    for (clp = func_call_cache; clp; clp = clp->next) {
        output_line ("func_%s.funcvoid = NULL;", clp->callname);
    }

    /* Clear sticky-linkage pointers */
    if (cb_sticky_linkage) {
        for (l = prog->parameter_list; l; l = CB_CHAIN (l)) {
            output_line ("cob_parm_%d = NULL;",
                      cb_code_field (CB_VALUE (l))->id);
        }
    }

    /* Clear RETURN-CODE */
    if (!prog->nested_level) {
        output_prefix ();
        output_integer (current_prog->cb_return_code);
        output (" = 0;\n");
    }

    output_line ("cob_cache_free (module);");
    output_line ("module = NULL;");
    output_newline ();

cancel_end:
    output_line ("initialized = 0;");
    output_line ("return 0;");
    output_newline ();
    /* End of CANCEL callback code */

prog_cancel_end:
    output_indent ("}");
    output_newline ();
    if (prog->prog_type == CB_FUNCTION_TYPE) {
        s = "FUNCTION-ID";
    } else {
        s = "PROGRAM-ID";
    }
    output_line ("/* End %s '%s' */", s, prog->orig_program_id);
    output_newline ();
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_label_info ( cb_tree  x, struct cb_label *  lp  )

static

Definition at line 4592 of file codegen.c.

References excp_current_paragraph, excp_current_section, cb_label::flag_dummy_exit, cb_label::flag_dummy_paragraph, cb_label::flag_dummy_section, cb_label::flag_entry, cb_label::flag_next_sentence, cb_label::flag_section, cb_label::name, NULL, cb_label::orig_name, output(), output_line(), output_newline(), output_prefix(), cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by output_stmt().

{
    if (lp->flag_dummy_section || lp->flag_dummy_paragraph) {
        return;
    }

    output_newline ();

    if (lp->flag_dummy_exit) {
        output_line ("/* Implicit EXIT label */");
        return;
    } else if (lp->flag_next_sentence) {
        output_line ("/* Implicit NEXT SENTENCE label */");
        return;
    }

    output_prefix ();
    if (x->source_file) {
        output ("/* Line: %-10d: ", x->source_line);
    } else {
        output ("/* ");
    }
    if (lp->flag_section) {
        output ("Section   %-24s", (const char *)lp->name);
        excp_current_section = (const char *)lp->name;
        excp_current_paragraph = NULL;
    } else {
        if (lp->flag_entry) {
            output ("Entry     %-24s", lp->orig_name);
            excp_current_section = NULL;
            excp_current_paragraph = NULL;
        } else {
            output ("Paragraph %-24s", (const char *)lp->name);
            excp_current_paragraph = (const char *)lp->name;
        }
    }
    if (x->source_file) {
        output (": %s */\n", x->source_file);
    } else {
        output ("*/\n");
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_line ( const char *  fmt,   ...  )

static

Definition at line 453 of file codegen.c.

References output_prefix(), and output_target.

Referenced by output_alter(), output_alter_check(), output_bin_field(), output_call(), output_class_name_definition(), output_error_handler(), output_ferror_stmt(), output_file_error(), output_file_initialization(), output_goto(), output_goto_1(), output_indent(), output_initialize(), output_initialize_compound(), output_initialize_literal(), output_initialize_one(), output_internal_function(), output_label_info(), output_main_function(), output_module_init(), output_perform_call(), output_perform_exit(), output_perform_until(), output_search_all(), output_search_whens(), output_section_info(), output_set_attribute(), and output_stmt().

{
    va_list     ap;

    if (output_target) {
        output_prefix ();
        va_start (ap, fmt);
        vfprintf (output_target, fmt, ap);
        va_end (ap);
        fputc ('\n', output_target);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_local ( const char *  fmt,   ...  )

static

Definition at line 527 of file codegen.c.

References cb_local_file.

Referenced by codegen(), output_alphabet_name_definition(), output_alter_check(), output_base(), output_file_allocation(), output_internal_function(), and output_screen_definition().

{
    va_list     ap;

    if (cb_local_file) {
        va_start (ap, fmt);
        vfprintf (cb_local_file, fmt, ap);
        va_end (ap);
    }
}

Here is the caller graph for this function:

static void output_long_integer ( cb_tree  x )

static

Definition at line 1366 of file codegen.c.

References _, cb_cast::cast_type, CB_BINARY_OP, CB_CAST, CB_CAST_ADDRESS, CB_CAST_PROGRAM_POINTER, CB_CONST, cb_fits_long_long(), CB_FMT_LLD_F, cb_get_long_long(), CB_INTEGER, cb_null, CB_PREFIX_BASE, CB_STORAGE_LINKAGE, CB_TAG_BINARY_OP, CB_TAG_CAST, CB_TAG_CONST, CB_TAG_INTEGER, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_TAG, CB_USAGE_BINARY, CB_USAGE_COMP_5, CB_USAGE_COMP_X, CB_USAGE_INDEX, CB_USAGE_LENGTH, CB_USAGE_POINTER, CB_USAGE_PROGRAM_POINTER, cb_zero, COBC_ABORT, cobc_abort_pr(), cb_binary_op::flag, cb_field::flag_binary_swap, gen_nested_tab, cb_picture::have_sign, hexval, cb_field::id, cb_field::indexes, cb_program::nested_prog_list, cb_field::offset, cb_binary_op::op, output(), output_base(), output_data(), output_func_1(), output_param(), cb_field::pic, cb_field::size, cb_field::special_index, cb_field::storage, cb_field::usage, cb_cast::val, cb_binary_op::x, and cb_binary_op::y.

Referenced by output_param().

{
    struct cb_binary_op *p;
    struct cb_cast      *cp;
    struct cb_field     *f;

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_CONST:
        if (x == cb_zero) {
            output ("0");
        } else if (x == cb_null) {
            output ("(cob_u8_ptr)NULL");
        } else {
            output ("%s", CB_CONST (x)->val);
        }
        break;
    case CB_TAG_INTEGER:
        if (CB_INTEGER (x)->hexval) {
            output ("0x%X", CB_INTEGER (x)->val);
        } else {
            output ("%d", CB_INTEGER (x)->val);
        }
        break;
    case CB_TAG_LITERAL:
        output (CB_FMT_LLD_F, cb_get_long_long (x));
        break;
    case CB_TAG_BINARY_OP:
        p = CB_BINARY_OP (x);
        if (p->flag) {
            if (!cb_fits_long_long (p->x) ||
                !cb_fits_long_long (p->y)) {
                output ("cob_get_llint (");
                output_param (x, -1);
                output (")");
                break;
            }
        }
        if (p->op == '^') {
            output ("(cob_s64_t) pow (");
            output_long_integer (p->x);
            output (", ");
            output_long_integer (p->y);
            output (")");
        } else {
            output ("(");
            output_long_integer (p->x);
            output (" %c ", p->op);
            output_long_integer (p->y);
            output (")");
        }
        break;
    case CB_TAG_CAST:
        cp = CB_CAST (x);
        switch (cp->cast_type) {
        case CB_CAST_ADDRESS:
            output ("(");
            output_data (cp->val);
            output (")");
            break;
        case CB_CAST_PROGRAM_POINTER:
            output ("cob_call_field (");
            output_param (x, -1);
            if (current_prog->nested_prog_list) {
                gen_nested_tab = 1;
                output (", cob_nest_tab, 0, %d)", cb_fold_call);
            } else {
                output (", NULL, 0, %d)", cb_fold_call);
            }
            break;
        default:
            cobc_abort_pr (_("Unexpected cast type %d"),
                 (int)cp->cast_type);
            COBC_ABORT ();
        }
        break;
    case CB_TAG_REFERENCE:
        f = cb_code_field (x);
        switch (f->usage) {
        case CB_USAGE_INDEX:
            if (f->special_index) {
                output_base (f, 1U);
                output ("(cob_s64_t)%s%d", CB_PREFIX_BASE, f->id);
                return;
            }
            /* Fall through */
        case CB_USAGE_LENGTH:
            output ("(cob_s64_t)(*(int *) (");
            output_data (x);
            output ("))");
            return;

        case CB_USAGE_POINTER:
#ifdef  COB_NON_ALIGNED
            output ("(cob_get_pointer (");
            output_data (x);
            output ("))");
#else
            output ("(*(unsigned char **) (");
            output_data (x);
            output ("))");
#endif
            return;

        case CB_USAGE_PROGRAM_POINTER:
#ifdef  COB_NON_ALIGNED
            output ("(cob_get_prog_pointer (");
            output_data (x);
            output ("))");
#else
            output ("(*(void **) (");
            output_data (x);
            output ("))");
#endif
            return;

        case CB_USAGE_BINARY:
        case CB_USAGE_COMP_5:
        case CB_USAGE_COMP_X:
            if (f->size == 1) {
                output ("(*(");
                if (!f->pic->have_sign) {
                    output ("cob_u8_ptr) (");
                } else {
                    output ("cob_s8_ptr) (");
                }
                output_data (x);
                output ("))");
                return;
            }
#ifdef  COB_NON_ALIGNED
            if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && (
#ifdef  COB_SHORT_BORK
                (f->size == 2 && (f->offset % 4 == 0)) ||
#else
                (f->size == 2 && (f->offset % 2 == 0)) ||
#endif
                (f->size == 4 && (f->offset % 4 == 0)) ||
                (f->size == 8 && (f->offset % 8 == 0)))) {
#else
            if (f->size == 2 || f->size == 4 || f->size == 8) {
#endif
                if (f->flag_binary_swap) {
                    output ("((");
                    switch (f->size) {
                    case 2:
                        if (!f->pic->have_sign) {
                            output ("unsigned short)COB_BSWAP_16(");
                        } else {
                            output ("short)COB_BSWAP_16(");
                        }
                        break;
                    case 4:
                        if (!f->pic->have_sign) {
                            output ("unsigned int)COB_BSWAP_32(");
                        } else {
                            output ("int)COB_BSWAP_32(");
                        }
                        break;
                    case 8:
                        if (!f->pic->have_sign) {
                            output ("cob_u64_t)COB_BSWAP_64(");
                        } else {
                            output ("cob_s64_t)COB_BSWAP_64(");
                        }
                        break;
                    default:
                        break;
                    }
                    output ("*(");
                    switch (f->size) {
                    case 2:
                        output ("short *)(");
                        break;
                    case 4:
                        output ("int *)(");
                        break;
                    case 8:
                        output ("cob_s64_t *)(");
                        break;
                    default:
                        break;
                    }
                    output_data (x);
                    output (")))");
                    return;
                } else {
                    output ("(*(");
                    switch (f->size) {
                    case 2:
                        if (!f->pic->have_sign) {
                            output ("unsigned short *)(");
                        } else {
                            output ("short *)(");
                        }
                        break;
                    case 4:
                        if (!f->pic->have_sign) {
                            output ("unsigned int *)(");
                        } else {
                            output ("int *)(");
                        }
                        break;
                    case 8:
                        if (!f->pic->have_sign) {
                            output ("cob_u64_ptr)(");
                        } else {
                            output ("cob_s64_ptr)(");
                        }
                        break;
                    default:
                        break;
                    }
                    output_data (x);
                    output ("))");
                    return;
                }
            }
#if 0   /* RXWRXW - unsigned */
            if (f->pic->have_sign == 0) {
                output ("(unsigned int)");
            }
#endif
            break;

        default:
            break;
        }

        output_func_1 ("cob_get_llint", x);
        break;
    case CB_TAG_INTRINSIC:
        output ("cob_get_llint (");
        output_param (x, -1);
        output (")");
        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 output_main_function ( struct cb_program *  prog )

static

Definition at line 7412 of file codegen.c.

References output_indent(), output_line(), and cb_program::program_id.

Referenced by codegen().

{
    output_line ("/* Main function */");
    output_line ("int");
    output_line ("main (int argc, char **argv)");
    output_indent ("{");
    output_line ("cob_init (argc, argv);");
    output_line ("cob_stop_run (%s ());", prog->program_id);
    output_indent ("}\n");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_module_init ( struct cb_program *  prog )

static

Definition at line 5705 of file codegen.c.

References CB_FUNCTION_TYPE, cb_ref(), cobc_flag_main, cb_program::collating_sequence, cb_program::crt_status, cb_program::currency_symbol, cb_program::cursor_pos, cb_program::decimal_point, cb_program::nested_level, no_physical_cancel, non_nested_count, cb_program::num_proc_params, cb_program::numeric_separator, cb_program::orig_program_id, output(), output_line(), output_newline(), output_param(), output_prefix(), cb_program::prog_type, and cb_program::program_id.

Referenced by output_internal_function().

{
#if 0   /* Module comments */
    output ("/* Next pointer, Parameter list pointer, Module name, */\n");
    output ("/* Module formatted date, Module source, */\n");
    output ("/* Module entry, Module cancel, */\n");
    output ("/* Collating, CRT status, CURSOR, */\n");
    output ("/* Module reference count, Module path, Module active, */\n");
    output ("/* Module date, Module time, */\n");
    output ("/* Module type, Number of USING parameters, Return type */\n");
    output ("/* Current parameter count */\n");
    output ("/* Display sign, Decimal point, Currency symbol, */\n");
    output ("/* Numeric separator, File name mapping, Binary truncate, */\n");
    output ("/* Alternate numeric display, Host sign, No physical cancel */\n");
    output ("/* Flag main program, Fold call, Exit after CALL */\n\n");
#endif

    /* Do not initialize next pointer, parameter list pointer + count */
    output_line ("/* Initialize module structure */");
    output_line ("module->module_name = \"%s\";", prog->orig_program_id);
    output_line ("module->module_formatted_date = COB_MODULE_FORMATTED_DATE;");
    output_line ("module->module_source = COB_SOURCE_FILE;");
    if (!prog->nested_level) {
        output_line ("module->module_entry.funcptr = (void *(*)())%s;",
                 prog->program_id);
        if (prog->prog_type == CB_FUNCTION_TYPE) {
            output_line ("module->module_cancel.funcptr = NULL;");
        } else {
            output_line ("module->module_cancel.funcptr = (void *(*)())%s_;",
                     prog->program_id);
        }
    } else {
        output_line ("module->module_entry.funcvoid = NULL;");
        output_line ("module->module_cancel.funcvoid = NULL;");
    }

    if (prog->collating_sequence) {
        output_prefix ();
        output ("module->collating_sequence = ");
        output_param (cb_ref (prog->collating_sequence), -1);
        output (";\n");
    } else {
        output_line ("module->collating_sequence = NULL;");
    }
    if (prog->crt_status && cb_code_field (prog->crt_status)->count) {
        output_prefix ();
        output ("module->crt_status = ");
        output_param (cb_ref (prog->crt_status), -1);
        output (";\n");
    } else {
        output_line ("module->crt_status = NULL;");
    }
    if (prog->cursor_pos) {
        output_prefix ();
        output ("module->cursor_pos = ");
        output_param (cb_ref (prog->cursor_pos), -1);
        output (";\n");
    } else {
        output_line ("module->cursor_pos = NULL;");
    }
    if (!cobc_flag_main && non_nested_count > 1) {
        output_line ("module->module_ref_count = &cob_reference_count;");
    } else {
        output_line ("module->module_ref_count = NULL;");
    }
    output_line ("module->module_path = &cob_module_path;");
    output_line ("module->module_active = 0;");
    output_line ("module->module_date = COB_MODULE_DATE;");
    output_line ("module->module_time = COB_MODULE_TIME;");
    output_line ("module->module_type = %d;", (int)prog->prog_type);
    output_line ("module->module_param_cnt = %d;", prog->num_proc_params);
    output_line ("module->module_returning = 0;");
    output_line ("module->ebcdic_sign = %d;", cb_ebcdic_sign);
    output_line ("module->decimal_point = '%c';", prog->decimal_point);
    output_line ("module->currency_symbol = '%c';", prog->currency_symbol);
    output_line ("module->numeric_separator = '%c';", prog->numeric_separator);
    output_line ("module->flag_filename_mapping = %d;", cb_filename_mapping);
    output_line ("module->flag_binary_truncate = %d;", cb_binary_truncate);
    output_line ("module->flag_pretty_display = %d;", cb_pretty_display);
    output_line ("module->flag_host_sign = %d;", cb_host_sign);
    output_line ("module->flag_no_phys_canc = %d;", no_physical_cancel);
    output_line ("module->flag_main = %d;", cobc_flag_main);
    output_line ("module->flag_fold_call = %d;", cb_fold_call);
    output_line ("module->flag_exit_program = 0;");
    output_newline ();
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_move ( cb_tree  src, cb_tree  dst  )

static

Definition at line 2235 of file codegen.c.

References cb_build_move(), cb_error_node, output_stmt(), suppress_warn, and cb_binary_op::x.

Referenced by output_call(), output_goto_1(), output_initialize_one(), output_internal_function(), output_perform(), output_perform_until(), output_search_whens(), and output_stmt().

{
    cb_tree     x;

    /* Suppress warnings */
    suppress_warn = 1;
    x = cb_build_move (src, dst);
    if (x != cb_error_node) {
        output_stmt (x);
    }
    suppress_warn = 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_newline ( void  )

static

Definition at line 433 of file codegen.c.

References output_target.

Referenced by codegen(), output_alter_check(), output_call(), output_class_name_definition(), output_cond(), output_error_handler(), output_internal_function(), output_label_info(), output_module_init(), output_perform_exit(), output_screen_init(), output_search_all(), output_search_whens(), and output_stmt().

{
    if (output_target) {
        fputs ("\n", output_target);
    }
}

Here is the caller graph for this function:

static void output_occurs ( struct cb_field *  p )

static

Definition at line 2896 of file codegen.c.

References cb_field::depending, cb_field::occurs_max, output(), and output_integer().

Referenced by output_search_all(), and output_search_whens().

{
    if (p->depending) {
        output_integer (p->depending);
    } else {
        output ("%d", p->occurs_max);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_param ( cb_tree  x, int  id  )

static

Definition at line 1628 of file codegen.c.

References _, cb_alphabet_name::alphabet_type, cb_intrinsic::args, cb_cast::cast_type, CB_ALPHABET_ASCII, CB_ALPHABET_CUSTOM, CB_ALPHABET_EBCDIC, CB_ALPHABET_NAME, CB_ALPHABET_NAME_P, CB_ALPHABET_NATIVE, CB_BINARY_OP, cb_build_field_reference(), CB_CAST, CB_CAST_ADDR_OF_ADDR, CB_CAST_ADDRESS, CB_CAST_INTEGER, CB_CAST_LENGTH, CB_CAST_LONG_INT, CB_CAST_PROGRAM_POINTER, CB_CHAIN, CB_CONST, CB_DECIMAL, CB_FIELD, CB_FILE, CB_FILE_P, CB_FUNC_PROTOTYPE, cb_int0, cb_int1, CB_INTRINSIC, cb_list_length(), CB_LOCALE_NAME, CB_LOCALE_NAME_P, CB_NEED_HIGH, CB_NEED_LOW, CB_NEED_QUOTE, CB_NEED_SPACE, CB_NEED_ZERO, cb_norm_high, cb_norm_low, CB_PREFIX_CONST, CB_PREFIX_FIELD, CB_PREFIX_FILE, CB_PREFIX_SEQUENCE, cb_quote, cb_ref(), CB_REFERENCE, cb_space, CB_STORAGE_SCREEN, CB_STRING, CB_TAG_ALPHABET_NAME, CB_TAG_BINARY_OP, CB_TAG_CAST, CB_TAG_CONST, CB_TAG_DECIMAL, CB_TAG_FIELD, CB_TAG_FILE, CB_TAG_FUNCALL, CB_TAG_INTEGER, CB_TAG_INTRINSIC, CB_TAG_LITERAL, CB_TAG_LOCALE_NAME, CB_TAG_REFERENCE, CB_TAG_STRING, CB_TREE_TAG, CB_VALUE, cb_zero, cb_reference::check, chk_field_variable_address(), chk_field_variable_size(), cb_alphabet_name::cname, COB_INSIDE_SIZE, COBC_ABORT, cobc_abort_pr(), cobc_parse_malloc(), cb_program::collating_sequence, cb_field::count, field_list::curr_prog, excp_current_program_id, field_list::f, field_cache, cb_field::flag_any_length, cb_field::flag_anylen_done, cb_field::flag_external, cb_field::flag_field, cb_program::flag_file_global, cb_field::flag_is_global, cb_field::flag_item_based, cb_field::flag_local, gen_alt_ebcdic, gen_custom, gen_dynamic, gen_ebcdic_ascii, gen_figurative, gen_full_ebcdic, gen_native, cb_field::id, inside_check, inside_stack, cb_intrinsic::intr_field, cb_intrinsic_table::intr_routine, cb_intrinsic::intr_tab, cb_intrinsic::isuser, cb_intrinsic::length, local_field_cache, lookup_func_call(), lookup_literal(), cb_intrinsic::name, field_list::next, nolitcast, NULL, num_cob_fields, cb_reference::offset, cb_intrinsic::offset, cb_binary_op::op, output(), output_attr(), output_data(), output_field(), output_funcall(), output_indent_level, output_integer(), output_long_integer(), output_prefix(), output_size(), output_stmt(), output_string(), output_target, param_id, real_field_founder(), cb_intrinsic_table::refmod, screenptr, cb_field::special_index, stack_id, cb_field::storage, cb_reference::subs, user_func_upper(), cb_cast::val, cb_reference::value, field_list::x, cb_binary_op::x, and cb_binary_op::y.

Referenced by output_call(), output_call_by_value_args(), output_cancel(), output_data(), output_file_initialization(), output_func_1(), output_funcall(), output_funcall_debug(), output_goto(), output_integer(), output_internal_function(), output_long_integer(), output_module_init(), output_perform(), output_screen_init(), and output_stmt().

{
    struct cb_reference *r;
    struct cb_field     *f;
    struct cb_field     *ff;
    struct cb_cast      *cp;
    struct cb_binary_op *bp;
    struct field_list   *fl;
    FILE            *savetarget;
    struct cb_intrinsic *ip;
    struct cb_alphabet_name *abp;
    struct cb_alphabet_name *rbp;
    cb_tree         l;
    char            *func;
    int         n;
    int         sav_stack_id;
    char            fname[12];

    param_id = id;

    if (x == NULL) {
        output ("NULL");
        return;
    }

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_CONST:
        if (x == cb_quote) {
            gen_figurative |= CB_NEED_QUOTE;
        } else if (x == cb_norm_low) {
            gen_figurative |= CB_NEED_LOW;
        } else if (x == cb_norm_high) {
            gen_figurative |= CB_NEED_HIGH;
        } else if (x == cb_space) {
            gen_figurative |= CB_NEED_SPACE;
        } else if (x == cb_zero) {
            gen_figurative |= CB_NEED_ZERO;
        }
        output ("%s", CB_CONST (x)->val);
        break;
    case CB_TAG_INTEGER:
        output_integer (x);
        break;
    case CB_TAG_STRING:
        output_string (CB_STRING (x)->data, (int) CB_STRING (x)->size, 0);
        break;
    case CB_TAG_LOCALE_NAME:
        output_param (CB_LOCALE_NAME(x)->list, id);
        break;
    case CB_TAG_ALPHABET_NAME:
        abp = CB_ALPHABET_NAME (x);
        switch (abp->alphabet_type) {
        case CB_ALPHABET_ASCII:
#ifdef  COB_EBCDIC_MACHINE
            gen_ebcdic_ascii = 1;
            output ("cob_ebcdic_ascii");
            break;
#endif
            /* Fall through for ASCII */
        case CB_ALPHABET_NATIVE:
            if (current_prog->collating_sequence) {
                gen_native = 1;
                output ("cob_native");
            } else {
                output ("NULL");
            }
            break;
        case CB_ALPHABET_EBCDIC:
#ifdef  COB_EBCDIC_MACHINE
            if (current_prog->collating_sequence) {
                gen_native = 1;
                output ("cob_native");
            } else {
                output ("NULL");
            }
#else
            if (cb_flag_alt_ebcdic) {
                gen_alt_ebcdic = 1;
                output ("cob_a2e");
            } else {
                gen_full_ebcdic = 1;
                output ("cob_ascii_ebcdic");
            }
#endif
            break;
        case CB_ALPHABET_CUSTOM:
            gen_custom = 1;
            output ("%s%s", CB_PREFIX_SEQUENCE, abp->cname);
            break;
        default:
            break;
        }
        break;
    case CB_TAG_CAST:
        cp = CB_CAST (x);
        switch (cp->cast_type) {
        case CB_CAST_INTEGER:
            output_integer (cp->val);
            break;
        case CB_CAST_LONG_INT:
            output_long_integer (cp->val);
            break;
        case CB_CAST_ADDRESS:
            output_data (cp->val);
            break;
        case CB_CAST_ADDR_OF_ADDR:
            output ("&");
            output_data (cp->val);
            break;
        case CB_CAST_LENGTH:
            output_size (cp->val);
            break;
        case CB_CAST_PROGRAM_POINTER:
            output_param (cp->val, id);
            break;
        default:
            break;
        }
        break;
    case CB_TAG_DECIMAL:
        output ("d%d", CB_DECIMAL (x)->id);
        break;
    case CB_TAG_FILE:
        output ("%s%s", CB_PREFIX_FILE, CB_FILE (x)->cname);
        break;
    case CB_TAG_LITERAL:
#if 0   /* RXWRXW - Const */
        output ("&%s%d.vf", CB_PREFIX_CONST, lookup_literal (x));
#else
        if (nolitcast) {
            output ("&%s%d", CB_PREFIX_CONST, lookup_literal (x));
        } else {
            output ("(cob_field *)&%s%d", CB_PREFIX_CONST,
                lookup_literal (x));
        }
#endif
        break;
    case CB_TAG_FIELD:
        /* TODO: remove me */
        output_param (cb_build_field_reference (CB_FIELD (x), NULL), id);
        break;
    case CB_TAG_REFERENCE:
        r = CB_REFERENCE (x);
        if (CB_LOCALE_NAME_P (r->value)) {
            output_param (CB_LOCALE_NAME(r->value)->list, id);
            break;
        }
        if (r->check) {
            inside_stack[inside_check++] = 0;
            if (inside_check >= COB_INSIDE_SIZE) {
                cobc_abort_pr (_("Internal statement stack depth exceeded -> %d"),
                        COB_INSIDE_SIZE);
                COBC_ABORT ();
            }
            output ("\n");
            output_prefix ();
            output ("(");
            n = output_indent_level;
            output_indent_level = 0;
            for (l = r->check; l; l = CB_CHAIN (l)) {
                sav_stack_id = stack_id;
                output_stmt (CB_VALUE (l));
                stack_id = sav_stack_id;
                if (l == r->check) {
                    output_indent_level = n;
                }
            }
        }

        if (CB_FILE_P (r->value)) {
            output ("%s%s", CB_PREFIX_FILE, CB_FILE (r->value)->cname);
            if (r->check) {
                if (inside_check) {
                    --inside_check;
                }
                output (" )");
            }
            break;
        }
        if (CB_ALPHABET_NAME_P (r->value)) {
            rbp = CB_ALPHABET_NAME (r->value);
            switch (rbp->alphabet_type) {
            case CB_ALPHABET_ASCII:
#ifdef  COB_EBCDIC_MACHINE
                gen_ebcdic_ascii = 2;
                output ("&f_ebcdic_ascii");
                break;
#endif
            /* Fall through for ASCII */
            case CB_ALPHABET_NATIVE:
                gen_native = 2;
                output ("&f_native");
                break;
            case CB_ALPHABET_EBCDIC:
#ifdef  COB_EBCDIC_MACHINE
                gen_native = 2;
                output ("&f_native");
#else
                gen_full_ebcdic = 2;
                output ("&f_ascii_ebcdic");
#endif
                break;
            case CB_ALPHABET_CUSTOM:
                gen_custom = 1;
                output ("&%s%s", CB_PREFIX_FIELD, rbp->cname);
                break;
            default:
                break;
            }
            if (r->check) {
                if (inside_check) {
                    --inside_check;
                }
                output (" )");
            }
            break;
        }

        f = CB_FIELD (r->value);

        ff = real_field_founder (f);

        if (ff->flag_external) {
            f->flag_external = 1;
            f->flag_local = 1;
        } else if (ff->flag_item_based) {
            f->flag_local = 1;
        }

        if (!r->subs && !r->offset && f->count > 0 &&
            !chk_field_variable_size (f) &&
            !chk_field_variable_address (f)) {
            if (!f->flag_field) {
                savetarget = output_target;
                output_target = NULL;
                output_field (x);

                fl = cobc_parse_malloc (sizeof (struct field_list));
                fl->x = x;
                fl->f = f;
                fl->curr_prog = excp_current_program_id;
                if (f->special_index != 2 && (f->flag_is_global ||
                    current_prog->flag_file_global)) {
                    fl->next = field_cache;
                    field_cache = fl;
                } else {
                    fl->next = local_field_cache;
                    local_field_cache = fl;
                }

                f->flag_field = 1;
                output_target = savetarget;
            }
            if (f->flag_local) {
#if 0   /* RXWRXW - Any data pointer */
                if (f->flag_any_length && f->flag_anylen_done) {
                    output ("&%s%d",
                        CB_PREFIX_FIELD, f->id);
                } else {
#endif
                output ("COB_SET_DATA (%s%d, ",
                    CB_PREFIX_FIELD, f->id);
                output_data (x);
                output (")");
#if 0   /* RXWRXW - Any data pointer */
                f->flag_anylen_done = 1;
                }
#endif
            } else {
                if (screenptr && f->storage == CB_STORAGE_SCREEN) {
                    output ("&s_%d", f->id);
                } else {
                    output ("&%s%d", CB_PREFIX_FIELD, f->id);
                }
            }
        } else {
            if (stack_id >= num_cob_fields) {
                num_cob_fields = stack_id + 1;
            }
            sprintf (fname, "f%d", stack_id++);
            if (inside_check != 0) {
                if (inside_stack[inside_check - 1] != 0) {
                    inside_stack[inside_check - 1] = 0;
                    output (",\n");
                    output_prefix ();
                }
            }
            output ("COB_SET_FLD(%s, ", fname);
            output_size (x);
            output (", ");
            output_data (x);
            output (", ");
            output_attr (x);
            output (")");
        }

        if (r->check) {
            if (inside_check) {
                --inside_check;
            }
            output (" )");
        }
        break;
    case CB_TAG_BINARY_OP:
        bp = CB_BINARY_OP (x);
        output ("cob_intr_binop (");
        output_param (bp->x, id);
        output (", ");
        output ("%d", bp->op);
        output (", ");
        output_param (bp->y, id);
        output (")");
        break;
    case CB_TAG_INTRINSIC:
        ip = CB_INTRINSIC (x);
        if (ip->isuser) {
            func = user_func_upper (CB_FUNC_PROTOTYPE (cb_ref (ip->name))->ext_name);
            lookup_func_call (func);
#if 0   /* RXWRXW Func */
            output ("cob_user_function (func_%s, &cob_dyn_%u, ",
                func, gen_dynamic);
#else
            output ("func_%s.funcfld (&cob_dyn_%u",
                func, gen_dynamic);
#endif
            gen_dynamic++;
            if (ip->intr_field || ip->args) {
                output (", ");
            }
#if 0   /* RXWRXW Func */
            if (ip->intr_tab->refmod) {
                if (ip->offset) {
                    output_integer (ip->offset);
                    output (", ");
                } else {
                    output ("0, ");
                }
                if (ip->length) {
                    output_integer (ip->length);
                } else {
                    output ("0");
                }
                if (ip->intr_field || ip->args) {
                    output (", ");
                }
            }
#endif
        } else {
            output ("%s (", ip->intr_tab->intr_routine);
            if (ip->intr_tab->refmod) {
                if (ip->offset) {
                    output_integer (ip->offset);
                    output (", ");
                } else {
                    output ("0, ");
                }
                if (ip->length) {
                    output_integer (ip->length);
                } else {
                    output ("0");
                }
                if (ip->intr_field || ip->args) {
                    output (", ");
                }
            }
        }
        if (ip->intr_field) {
            if (ip->intr_field == cb_int0) {
                output ("NULL");
            } else if (ip->intr_field == cb_int1) {
                output ("%d", cb_list_length (ip->args));
            } else {
                output_param (ip->intr_field, id);
            }
            if (ip->args) {
                output (", ");
            }
        }
        for (l = ip->args; l; l = CB_CHAIN (l)) {
            output_param (CB_VALUE (l), id);
            id++;
            param_id++;
            if (CB_CHAIN (l)) {
                output (", ");
            }
        }
        output (")");
        break;
    case CB_TAG_FUNCALL:
        output_funcall (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 output_perform ( struct cb_perform *  p )

static

Definition at line 4266 of file codegen.c.

References cb_build_cast_llint(), cb_build_debug(), cb_debug_contents, cb_debug_name, CB_FIELD, CB_LABEL, CB_PERFORM_EXIT, CB_PERFORM_FOREVER, CB_PERFORM_ONCE, CB_PERFORM_TIMES, CB_PERFORM_UNTIL, CB_PERFORM_VARYING, cb_ref(), CB_VALUE, cb_perform::data, cb_field::debug_section, cb_perform::exit_label, cb_field::flag_field_debug, cb_program::flag_gen_debug, cb_perform_varying::from, loop_counter, cb_field::name, cb_perform_varying::name, NULL, output(), output_indent(), output_move(), output_param(), output_perform_call(), output_perform_exit(), output_perform_once(), output_perform_until(), output_prefix(), output_stmt(), cb_perform::perform_type, and cb_perform::varying.

Referenced by output_stmt().

{
    struct cb_perform_varying   *v;
    struct cb_field         *f;

    switch (p->perform_type) {
    case CB_PERFORM_EXIT:
        if (CB_LABEL (p->data)->flag_return) {
            output_perform_exit (CB_LABEL (p->data));
        }
        break;
    case CB_PERFORM_ONCE:
        output_perform_once (p);
        break;
    case CB_PERFORM_TIMES:
        output_prefix ();
        output ("for (n%d = ", loop_counter);
        output_param (cb_build_cast_llint (p->data), 0);
        output ("; n%d > 0; n%d--)\n", loop_counter, loop_counter);
        loop_counter++;
        output_indent ("{");
        output_perform_once (p);
        output_indent ("}");
        break;
    case CB_PERFORM_UNTIL:
        v = CB_PERFORM_VARYING (CB_VALUE (p->varying));
        if (v->name) {
            output_move (v->from, v->name);
            /* DEBUG */
            if (current_prog->flag_gen_debug) {
                f = CB_FIELD (cb_ref (v->name));
                if (f->flag_field_debug) {
                    output_stmt (cb_build_debug (cb_debug_name,
                             (const char *)f->name, NULL));
                    output_stmt (cb_build_debug (cb_debug_contents,
                                     NULL, v->name));
                    output_perform_call (f->debug_section,
                                 f->debug_section);
                }
            }

        }
        output_perform_until (p, p->varying);
        break;
    case CB_PERFORM_FOREVER:
        output_prefix ();
        output ("for (;;)\n");
        output_indent ("{");
        output_perform_once (p);
        output_indent ("}");
        break;
    default:
        break;
    }
    if (p->exit_label) {
        output_stmt (cb_ref (p->exit_label));
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_perform_call ( struct cb_label *  lb, struct cb_label *  le  )

static

Definition at line 3905 of file codegen.c.

References cb_program::all_procedure, label_list::call_num, cb_build_debug(), cb_debug_name, cb_id, CB_PREFIX_LABEL, cobc_parse_malloc(), cb_label::flag_alter, cb_label::flag_debugging_mode, cb_program::flag_gen_debug, cb_label::flag_is_debug_sect, cb_label::flag_real_label, cb_label::flag_section, cb_program::flag_segments, label_list::id, cb_label::id, label_cache, last_segment, cb_label::name, label_list::next, cb_para_label::next, NULL, output_line(), output_stmt(), cb_para_label::para, cb_label::para_label, cb_label::section, cb_label::section_id, and cb_label::segment.

Referenced by output_alter(), output_cond_debug(), output_error_handler(), output_file_error(), output_funcall_debug(), output_goto(), output_perform(), output_perform_once(), output_perform_until(), and output_stmt().

{
    struct cb_para_label    *p;
    struct label_list   *l;

    if (lb == current_prog->all_procedure || lb->flag_is_debug_sect) {
        output_line ("/* DEBUGGING Callback PERFORM %s */",
                 (const char *)lb->name);
    } else if (lb == le) {
        output_line ("/* PERFORM %s */", (const char *)lb->name);
    } else {
        output_line ("/* PERFORM %s THRU %s */", (const char *)lb->name,
                 (const char *)le->name);
    }

    /* Save current independent segment pointers */
    if (current_prog->flag_segments && last_section &&
        last_section->section_id != lb->section_id) {
        p = last_section->para_label;
        for (; p; p = p->next) {
            if (p->para->segment > 49 &&
                p->para->flag_alter) {
                output_line ("save_label_%s%d = label_%s%d;",
                         CB_PREFIX_LABEL, p->para->id,
                         CB_PREFIX_LABEL, p->para->id);
            }
        }
    }
    /* Zap target independent labels */
    if (current_prog->flag_segments && last_segment != lb->segment) {
        if (lb->flag_section) {
            p = lb->para_label;
        } else if (lb->section) {
            p = lb->section->para_label;
        } else {
            p = NULL;
        }
        for (; p; p = p->next) {
            if (p->para->segment > 49 &&
                p->para->flag_alter) {
                output_line ("label_%s%d = 0;",
                         CB_PREFIX_LABEL, p->para->id);
            }
        }
    }

    /* Update debugging name */
    if (current_prog->flag_gen_debug && lb->flag_real_label &&
        (current_prog->all_procedure || lb->flag_debugging_mode)) {
        output_stmt (cb_build_debug (cb_debug_name,
                         (const char *)lb->name, NULL));
    }

    output_line ("frame_ptr++;");
    if (cb_flag_stack_check) {
        output_line ("if (unlikely(frame_ptr == frame_overflow))");
        output_line ("    cob_fatal_error (COB_FERROR_STACK);");
    }
    output_line ("frame_ptr->perform_through = %d;", le->id);
    if (!cb_flag_computed_goto) {
        l = cobc_parse_malloc (sizeof (struct label_list));
        l->next = label_cache;
        l->id = cb_id;
        if (label_cache == NULL) {
            l->call_num = 0;
        } else {
            l->call_num = label_cache->call_num + 1;
        }
        label_cache = l;
        output_line ("frame_ptr->return_address_num = %d;", l->call_num);
        output_line ("goto %s%d;", CB_PREFIX_LABEL, lb->id);
        output_line ("%s%d:", CB_PREFIX_LABEL, cb_id);
    } else {
        output_line ("frame_ptr->return_address_ptr = &&%s%d;",
                 CB_PREFIX_LABEL, cb_id);
        output_line ("goto %s%d;", CB_PREFIX_LABEL, lb->id);
        output_line ("%s%d:", CB_PREFIX_LABEL, cb_id);
    }
    output_line ("frame_ptr--;");
    cb_id++;

    if (current_prog->flag_segments && last_section &&
        last_section->section_id != lb->section_id) {
        /* Restore current independent segment pointers */
        p = last_section->para_label;
        for (; p; p = p->next) {
            if (p->para->segment > 49 &&
                p->para->flag_alter) {
                output_line ("label_%s%d = save_label_%s%d;",
                         CB_PREFIX_LABEL, p->para->id,
                         CB_PREFIX_LABEL, p->para->id);
            }
        }
        /* Zap target independent labels */
        if (lb->flag_section) {
            p = lb->para_label;
        } else if (lb->section) {
            p = lb->section->para_label;
        } else {
            p = NULL;
        }
        for (; p; p = p->next) {
            if (p->para->segment > 49 &&
                p->para->flag_alter) {
                output_line ("label_%s%d = 0;",
                         CB_PREFIX_LABEL, p->para->id);
            }
        }
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_perform_exit ( struct cb_label *  l )

static

Definition at line 4017 of file codegen.c.

References CB_PROGRAM_TYPE, cb_label::flag_declarative_exit, cb_label::flag_default_handler, cb_label::flag_fatal_check, cb_label::flag_global, cb_program::flag_recursive, cb_label::id, output_line(), output_newline(), and cb_program::prog_type.

Referenced by output_error_handler(), and output_perform().

{
    if (l->flag_global) {
        output_newline ();
        output_line ("/* Implicit GLOBAL DECLARATIVE return */");
        output_line ("if (entry == %d) {", l->id);
        output_line ("  cob_module_leave (module);");
        if (cb_flag_stack_on_heap || current_prog->flag_recursive) {
            output_line ("  cob_free (frame_stack);");
            output_line ("  cob_free (cob_procedure_params);");
            output_line ("  cob_cache_free (module);");
        }
        output_line ("  return 0;");
        output_line ("}");
    }
    output_newline ();

    if (l->flag_declarative_exit) {
        output_line ("/* Implicit DECLARATIVE return */");
    } else if (l->flag_default_handler) {
        output_line ("/* Implicit Default Error Handler return */");
    } else {
        output_line ("/* Implicit PERFORM return */");
    }

    if (cb_perform_osvs && current_prog->prog_type == CB_PROGRAM_TYPE) {
        output_line
            ("for (temp_index = frame_ptr; temp_index->perform_through; temp_index--) {");
        output_line ("  if (temp_index->perform_through == %d) {", l->id);
        output_line ("    frame_ptr = temp_index;");
        if (!cb_flag_computed_goto) {
            output_line ("    goto P_switch;");
        } else {
            output_line ("    goto *frame_ptr->return_address_ptr;");
        }
        output_line ("  }");
        output_line ("}");
    } else {
        output_line ("if (frame_ptr->perform_through == %d)", l->id);
        if (!cb_flag_computed_goto) {
            output_line ("  goto P_switch;");
        } else {
            output_line ("  goto *frame_ptr->return_address_ptr;");
        }
    }

    if (l->flag_fatal_check) {
        output_newline ();
        output_line ("/* Fatal error if reached */");
        output_line ("cob_fatal_error (COB_FERROR_GLOBAL);");
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_perform_once ( struct cb_perform *  p )

static

Definition at line 4189 of file codegen.c.

References cb_perform::body, CB_LABEL, CB_PAIR_P, CB_PAIR_X, CB_PAIR_Y, cb_ref(), cb_perform::cycle_label, output_perform_call(), and output_stmt().

Referenced by output_perform(), and output_perform_until().

{
    if (p->body && CB_PAIR_P (p->body)) {
        output_perform_call (CB_LABEL (cb_ref (CB_PAIR_X (p->body))),
                     CB_LABEL (cb_ref (CB_PAIR_Y (p->body))));
    } else {
        output_stmt (p->body);
    }
    if (p->cycle_label) {
        output_stmt (cb_ref (p->cycle_label));
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_perform_until ( struct cb_perform *  p, cb_tree  l  )

static

Definition at line 4203 of file codegen.c.

References CB_AFTER, CB_BEFORE, cb_build_debug(), CB_CHAIN, cb_debug_contents, cb_debug_name, CB_FIELD, CB_PERFORM_VARYING, cb_ref(), CB_VALUE, cb_field::debug_section, cb_field::flag_field_debug, cb_program::flag_gen_debug, cb_field::name, NULL, output(), output_cond(), output_cond_debug(), output_indent(), output_line(), output_move(), output_perform_call(), output_perform_once(), output_prefix(), output_stmt(), cb_perform_varying::step, cb_perform::test, and cb_perform_varying::until.

Referenced by output_perform().

{
    struct cb_perform_varying   *v;
    struct cb_field         *f;
    cb_tree             next;

    if (l == NULL) {
        /* Perform body at the end */
        output_perform_once (p);
        return;
    }

    v = CB_PERFORM_VARYING (CB_VALUE (l));
    next = CB_CHAIN (l);

    output_line ("for (;;)");
    output_indent ("{");

    if (next && CB_PERFORM_VARYING (CB_VALUE (next))->name) {
        output_move (CB_PERFORM_VARYING (CB_VALUE (next))->from,
                 CB_PERFORM_VARYING (CB_VALUE (next))->name);
        /* DEBUG */
        if (current_prog->flag_gen_debug) {
            f = CB_FIELD (cb_ref (CB_PERFORM_VARYING (CB_VALUE (next))->name));
            if (f->flag_field_debug) {
                output_stmt (cb_build_debug (cb_debug_name,
                         (const char *)f->name, NULL));
                output_stmt (cb_build_debug (cb_debug_contents,
                                 NULL, CB_PERFORM_VARYING (CB_VALUE (next))->name));
                output_perform_call (f->debug_section,
                             f->debug_section);
            }
        }

    }

    if (p->test == CB_AFTER) {
        output_perform_until (p, next);
    }

    /* DEBUG */
    if (current_prog->flag_gen_debug) {
        output_cond_debug (v->until);
    }

    output_prefix ();
    output ("if (");
    output_cond (v->until, 0);
    output (")\n");
    output_line ("  break;");

    if (p->test == CB_BEFORE) {
        output_perform_until (p, next);
    }

    if (v->step) {
        output_stmt (v->step);
    }

    output_indent ("}");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_prefix ( void  )

static

Definition at line 441 of file codegen.c.

References output_indent_level, and output_target.

Referenced by output_call(), output_cancel(), output_cond(), output_error_handler(), output_figurative(), output_file_initialization(), output_goto(), output_initialize_fp(), output_initialize_fp_bindec(), output_initialize_literal(), output_initialize_one(), output_initialize_uniform(), output_internal_function(), output_label_info(), output_line(), output_module_init(), output_param(), output_perform(), output_perform_until(), output_screen_init(), output_search_all(), output_search_whens(), output_stmt(), and output_trace_info().

{
    int i;

    if (output_target) {
        for (i = 0; i < output_indent_level; i++) {
            fputc (' ', output_target);
        }
    }
}

Here is the caller graph for this function:

static void output_screen_definition ( struct cb_field *  p )

static

Definition at line 5354 of file codegen.c.

References cb_field::children, COB_SCREEN_TYPE_ATTRIBUTE, COB_SCREEN_TYPE_FIELD, COB_SCREEN_TYPE_GROUP, COB_SCREEN_TYPE_VALUE, cb_field::count, cb_field::id, output_local(), cb_field::sister, cb_field::size, and cb_field::values.

Referenced by output_internal_function().

{
    int type;

    if (p->sister) {
        output_screen_definition (p->sister);
    }
    if (p->children) {
        output_screen_definition (p->children);
    }

    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 || type == COB_SCREEN_TYPE_VALUE) {
        p->count++;
    }

    output_local ("static cob_screen\ts_%d;\n", p->id);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_screen_init ( struct cb_field *  p, struct cb_field *  previous  )

static

Definition at line 5376 of file codegen.c.

References cb_build_field_reference(), cb_field::children, COB_SCREEN_TYPE_ATTRIBUTE, COB_SCREEN_TYPE_FIELD, COB_SCREEN_TYPE_GROUP, COB_SCREEN_TYPE_VALUE, cb_field::id, cb_field::level, NULL, cb_field::occurs_min, output(), output_newline(), output_param(), output_prefix(), cb_field::parent, cb_field::screen_backg, cb_field::screen_column, cb_field::screen_flag, cb_field::screen_foreg, cb_field::screen_line, cb_field::screen_prompt, cb_field::sister, cb_field::size, and cb_field::values.

Referenced by output_internal_function().

{
    int type;

    type = (p->children ? COB_SCREEN_TYPE_GROUP :
        p->values ? COB_SCREEN_TYPE_VALUE :
        (p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE);
    output_prefix ();
    output ("cob_set_screen (&s_%d, ", p->id);

    if (p->sister && p->sister->level != 1) {
        output ("&s_%d, ", p->sister->id);
    } else {
        output ("NULL, ");
    }

    if (previous && previous->level != 1) {
        output ("&s_%d, ", previous->id);
    } else {
        output ("NULL, ");
    }

    output_newline ();
    output_prefix ();
    output ("\t\t  ");

    if (type == COB_SCREEN_TYPE_GROUP) {
        output ("&s_%d, ", p->children->id);
    } else {
        output ("NULL, ");
    }

    if (p->parent) {
        output ("&s_%d, ", p->parent->id);
    } else {
        output ("NULL, ");
    }

    if (type == COB_SCREEN_TYPE_FIELD) {
        output_param (cb_build_field_reference (p, NULL), -1);
        output (", ");
    } else {
        output ("NULL, ");
    }

    output_newline ();
    output_prefix ();
    output ("\t\t  ");

    if (type == COB_SCREEN_TYPE_VALUE) {
        /* Need a field reference here */
        output_param (cb_build_field_reference (p, NULL), -1);
        output (", ");
    } else {
        output ("NULL, ");
    }

    if (p->screen_line) {
        output_param (p->screen_line, 0);
        output (", ");
    } else {
        output ("NULL, ");
    }

    if (p->screen_column) {
        output_param (p->screen_column, 0);
        output (", ");
    } else {
        output ("NULL, ");
    }

    output_newline ();
    output_prefix ();
    output ("\t\t  ");

    if (p->screen_foreg) {
        output_param (p->screen_foreg, 0);
        output (", ");
    } else {
        output ("NULL, ");
    }

    if (p->screen_backg) {
        output_param (p->screen_backg, 0);
        output (", ");
    } else {
        output ("NULL, ");
    }

    if (p->screen_prompt) {
        output_param (p->screen_prompt, 0);
        output (", ");
    } else {
        output ("NULL, ");
    }

    output_newline ();
    output_prefix ();
    output ("\t\t  ");

    output ("%d, %d, 0x%x);\n", type, p->occurs_min, p->screen_flag);

    if (p->children) {
        output_screen_init (p->children, NULL);
    }
    if (p->sister) {
        output_screen_init (p->sister, p);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_search ( struct cb_search *  p )

static

Definition at line 3033 of file codegen.c.

References CB_IF, cb_search::end_stmt, cb_search::flag_all, output_search_all(), output_search_whens(), cb_search::table, cb_search::var, and cb_search::whens.

Referenced by output_stmt().

{
    if (p->flag_all) {
        output_search_all (p->table, p->end_stmt,
                   CB_IF (p->whens)->test, CB_IF (p->whens)->stmt1);
    } else {
        output_search_whens (p->table, p->var, p->end_stmt, p->whens);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_search_all ( cb_tree  table, cb_tree  stmt, cb_tree  cond, cb_tree  when  )

static

Definition at line 2971 of file codegen.c.

References CB_VALUE, cb_field::index_list, cb_field::occurs_min, output(), output_cond(), output_indent(), output_integer(), output_line(), output_newline(), output_occurs(), output_prefix(), and output_stmt().

Referenced by output_search().

{
    struct cb_field *p;
    cb_tree     idx;

    p = cb_code_field (table);
    idx = CB_VALUE (p->index_list);
    /* Header */
    output_indent ("{");
    output_line ("int ret;");
    output_line ("int head = %d - 1;", p->occurs_min);
    output_prefix ();
    output ("int tail = ");
    output_occurs (p);
    output (" + 1;\n");

    /* Start loop */
    output_line ("for (;;)");
    output_indent ("{");

    /* End test */
    output_line ("if (head >= tail - 1)");
    output_indent ("{");
    output_line ("/* Table end */");
    if (stmt) {
        output_stmt (stmt);
    } else {
        output_line ("break;");
    }
    output_indent ("}");

    /* Next index */
    output_prefix ();
    output_integer (idx);
    output (" = (head + tail) / 2;\n");
    output_newline ();

    /* WHEN test */
    output_line ("/* WHEN */");
    output_prefix ();
    output ("if (");
    output_cond (cond, 1);
    output (")\n");
    output_indent ("{");
    output_stmt (when);
    output_indent ("}");

    output_line ("if (ret < 0)");
    output_prefix ();
    output ("  head = ");
    output_integer (idx);
    output (";\n");
    output_line ("else");
    output_prefix ();
    output ("  tail = ");
    output_integer (idx);
    output (";\n");
    output_indent ("}");
    output_indent ("}");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_search_whens ( cb_tree  table, cb_tree  var, cb_tree  stmt, cb_tree  whens  )

static

Definition at line 2906 of file codegen.c.

References _, CB_CHAIN, cb_ref(), CB_VALUE, COBC_ABORT, cobc_abort_pr(), cb_field::index_list, NULL, output(), output_indent(), output_indent_level, output_integer(), output_line(), output_move(), output_newline(), output_occurs(), output_prefix(), and output_stmt().

Referenced by output_search().

{
    cb_tree     l;
    struct cb_field *p;
    cb_tree     idx;

    idx = NULL;
    p = cb_code_field (table);

    if (!p->index_list) {
        cobc_abort_pr (_("Call to '%s' with invalid parameter '%s'"),
            "output_search", "table");
        COBC_ABORT ();
    }

    /* Determine the index to use */
    if (var) {
        for (l = p->index_list; l; l = CB_CHAIN (l)) {
            if (cb_ref (CB_VALUE (l)) == cb_ref (var)) {
                idx = var;
            }
        }
    }
    if (!idx) {
        idx = CB_VALUE (p->index_list);
    }

    /* Start loop */
    output_line ("for (;;) {");
    output_indent_level += 2;

    /* End test */
    output_prefix ();
    output ("if (");
    output_integer (idx);
    output (" > ");
    output_occurs (p);
    output (")\n");
    output_indent ("{");
    output_line ("/* Table end */");
    if (stmt) {
        output_stmt (stmt);
    } else {
        output_line ("break;");
    }
    output_indent ("}");

    /* WHEN test */
    output_stmt (whens);

    /* Iteration */
    output_newline ();
    output_prefix ();
    output_integer (idx);
    output ("++;\n");
    if (var && var != idx) {
        output_move (idx, var);
    }
    output_line ("/* Iterate */");
    /* End loop */
    output_indent_level -= 2;
    output_line ("}");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_section_info ( struct cb_label *  lp )

static

Definition at line 4525 of file codegen.c.

References CB_PREFIX_STRING, cb_standard_error_handler, CB_TREE, cb_label::flag_dummy_exit, cb_label::flag_dummy_paragraph, cb_label::flag_dummy_section, cb_label::flag_entry, cb_label::flag_section, lookup_string(), cb_label::orig_name, output_line(), and string_buffer.

Referenced by output_stmt().

{
    if (CB_TREE (lp) == cb_standard_error_handler) {
        return;
    }
    if (lp->flag_dummy_exit) {
        return;
    }
    if (lp->flag_section) {
        if (!lp->flag_dummy_section) {
            sprintf (string_buffer, "Section:   %s", lp->orig_name);
        } else {
            sprintf (string_buffer, "Section:   (None)");
        }
    } else if (lp->flag_entry) {
        sprintf (string_buffer, "Entry:     %s", lp->orig_name);
    } else {
        if (!lp->flag_dummy_paragraph) {
            sprintf (string_buffer, "Paragraph: %s", lp->orig_name);
        } else {
            sprintf (string_buffer, "Paragraph: (None)");
        }
    }
    if (CB_TREE (lp)->source_file) {
        output_line ("cob_trace_section (%s%d, %s%d, %d);",
                 CB_PREFIX_STRING,
                 lookup_string (string_buffer),
                 CB_PREFIX_STRING,
                 lookup_string (CB_TREE (lp)->source_file),
                 CB_TREE (lp)->source_line);
    } else {
        output_line ("cob_trace_section (%s%d, NULL, %d);",
                 CB_PREFIX_STRING,
                 lookup_string (string_buffer),
                 CB_TREE (lp)->source_line);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_set_attribute ( const struct cb_field *  f, int  val_on, int  val_off  )

static

Definition at line 3837 of file codegen.c.

References COB_SCREEN_HIGHLIGHT, COB_SCREEN_LOWLIGHT, cb_field::id, and output_line().

Referenced by output_stmt().

{
    /* Extension */
    /* Prevent specifying HIGHLIGHT and LOWLIGHT simultaneously. */
    if (val_on & COB_SCREEN_HIGHLIGHT) {
        val_off |= COB_SCREEN_LOWLIGHT;
    } else if (val_on & COB_SCREEN_LOWLIGHT) {
        val_off |= COB_SCREEN_HIGHLIGHT;
    }

    if (val_on) {
        output_line ("s_%d.attr |= 0x%x;", f->id, val_on);
    }
    if (val_off) {
        output_line ("s_%d.attr &= ~0x%x;", f->id, val_off);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_size ( const cb_tree  x )

static

Definition at line 793 of file codegen.c.

References _, CB_FIELD, cb_field_subordinate(), CB_LITERAL, CB_PREFIX_FIELD, CB_REFERENCE, CB_TAG_CONST, CB_TAG_FIELD, CB_TAG_LITERAL, CB_TAG_REFERENCE, CB_TREE_TAG, chk_field_variable_size(), COBC_ABORT, cobc_abort_pr(), cb_field::depending, cb_field::flag_any_length, cb_field::flag_no_field, cb_field::flag_odo_relative, cb_reference::flag_receiving, cb_field::id, cb_reference::length, cb_field::occurs_max, cb_field::odo_level, cb_field::offset, cb_reference::offset, output(), output_index(), output_integer(), cb_field::parent, cb_field::redefines, cb_literal::sign, cb_field::sister, cb_literal::size, cb_field::size, and cb_reference::value.

Referenced by codegen(), output_call(), output_field(), output_figurative(), output_initialize_literal(), output_initialize_uniform(), output_internal_function(), and output_param().

{
    struct cb_literal   *l;
    struct cb_reference *r;
    struct cb_field     *f;
    struct cb_field     *p;
    struct cb_field     *q;

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_CONST:
        output ("1");
        break;
    case CB_TAG_LITERAL:
        l = CB_LITERAL (x);
        output ("%d", (int)(l->size + ((l->sign != 0) ? 1 : 0)));
        break;
    case CB_TAG_REFERENCE:
        r = CB_REFERENCE (x);
        f = CB_FIELD (r->value);
        if (f->flag_no_field) {
            output ("0");
            break;
        }
        if (r->length) {
            output_integer (r->length);
        } else if (r->offset && f->flag_any_length) {
            output ("%s%d.size - ", CB_PREFIX_FIELD, f->id);
            output_index (r->offset);
        } else {
            p = chk_field_variable_size (f);
            q = f;
again:
            if (!cb_flag_odoslide && p && p->flag_odo_relative) {
                q = p;
                output ("%d", p->size * p->occurs_max);
            } else if (p && (!r->flag_receiving ||
                   !cb_field_subordinate (cb_code_field (p->depending),
                              q))) {
                if (p->offset - q->offset > 0) {
                    output ("%d + ", p->offset - q->offset);
                }
                if (p->size != 1) {
#if 0 /* draft from Simon -
         works only if the ODOs are directly nested and
         have no "sister" elements,
         the content would only be correct if -fodoslide
         is active as we need a temporary field otherwise */
                    /* size for nested ODO */
                    if (p->odo_level > 1) {
                        output_integer (p->depending);
                        output (" * ");
                        p = q;
                        goto again;
                    }
#endif
                    output ("%d * ", p->size);
                }
                output_integer (p->depending);
                q = p;
            } else {
                output ("%d", q->size);
            }

            for (; q != f; q = q->parent) {
                if (q->sister && !q->sister->redefines) {
                    q = q->sister;
                    p = q->depending ? q : chk_field_variable_size (q);
                    output (" + ");
                    goto again;
                }
            }
            if (r->offset) {
                output (" - ");
                output_index (r->offset);
            }
        }
        break;
    case CB_TAG_FIELD:
        output ("(int)%s%d.size", CB_PREFIX_FIELD, CB_FIELD (x)->id);
        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 output_stmt ( cb_tree  x )

static

Definition at line 4660 of file codegen.c.

References _, cb_program::all_procedure, cb_statement::body, cb_cast::cast_type, CB_ALTER, CB_ASSIGN, cb_build_debug(), CB_CALL, CB_CANCEL, CB_CAST, CB_CAST_ADDRESS, CB_CAST_PROGRAM_POINTER, CB_CHAIN, CB_CLASS_POINTER, CB_DEBUG, CB_DEBUG_CALL, cb_debug_contents, cb_debug_line, cb_debug_name, CB_DIRECT, cb_error_node, CB_EXCEPTION_CODE, CB_EXCEPTION_ENABLE, CB_FILE, CB_GOTO, cb_id, CB_IF, CB_INITIALIZE, CB_LABEL, cb_null, CB_PERFORM, CB_PREFIX_LABEL, CB_PREFIX_STRING, CB_REFERENCE, CB_SEARCH, CB_SET_ATTR, cb_space, CB_STATEMENT, CB_TAG_ALTER, CB_TAG_ASSIGN, CB_TAG_CALL, CB_TAG_CANCEL, CB_TAG_CAST, CB_TAG_CONTINUE, CB_TAG_DEBUG, CB_TAG_DEBUG_CALL, CB_TAG_DIRECT, CB_TAG_FUNCALL, CB_TAG_GOTO, CB_TAG_IF, CB_TAG_INITIALIZE, CB_TAG_LABEL, CB_TAG_LIST, CB_TAG_PERFORM, CB_TAG_REFERENCE, CB_TAG_SEARCH, CB_TAG_SET_ATTR, CB_TAG_STATEMENT, CB_TREE_CLASS, CB_TREE_TAG, CB_VALUE, cb_zero, COB_EC_I_O, COBC_ABORT, cobc_abort_pr(), cb_statement::debug_check, cb_label::debug_section, cb_label::exit_label, cb_statement::file, cb_label::flag_alter, cb_label::flag_begin, cb_statement::flag_callback, cb_program::flag_debugging, cb_label::flag_debugging_mode, cb_program::flag_gen_debug, cb_statement::flag_in_debug, cb_label::flag_is_debug_sect, cb_label::flag_real_label, cb_label::flag_section, cb_label::flag_skip_label, cb_set_attr::fld, gen_if_level, gen_nested_tab, cb_statement::handler1, cb_statement::handler2, cb_statement::handler_id, cb_label::id, inside_check, inside_stack, cb_if::is_if, last_line, last_segment, line, lookup_string(), cb_label::name, cb_statement::name, need_save_exception, cb_program::nested_prog_list, cb_para_label::next, NULL, cb_statement::null_check, output(), output_alter(), output_alter_check(), output_call(), output_cancel(), output_cond(), output_data(), output_ferror_stmt(), output_funcall(), output_goto(), output_indent(), output_indent_level, output_initialize(), output_integer(), output_label_info(), output_line(), output_move(), output_newline(), output_param(), output_perform(), output_perform_call(), output_prefix(), output_search(), output_section_info(), output_set_attribute(), output_trace_info(), cb_para_label::para, cb_label::para_label, cb_label::segment, cb_tree_common::source_file, cb_tree_common::source_line, stack_id, cb_if::stmt1, cb_if::stmt2, cb_if::test, unlikely, cb_cast::val, cb_assign::val, cb_set_attr::val_off, cb_set_attr::val_on, value, and cb_assign::var.

Referenced by output_alter(), output_call(), output_cond(), output_cond_debug(), output_error_handler(), output_ferror_stmt(), output_file_error(), output_funcall_debug(), output_goto(), output_goto_1(), output_initial_values(), output_internal_function(), output_move(), output_param(), output_perform(), output_perform_call(), output_perform_once(), output_perform_until(), output_search_all(), and output_search_whens().

{
    struct cb_statement *p;
    struct cb_label     *lp;
    struct cb_assign    *ap;
    struct cb_if        *ip;
    struct cb_para_label    *pal;
    struct cb_set_attr  *sap;
#ifdef  COB_NON_ALIGNED
    struct cb_cast      *cp;
#endif
    size_t          size;
    int         code;

    stack_id = 0;
    if (x == NULL) {
        output_line (";");
        return;
    }
    if (unlikely(x == cb_error_node)) {
        cobc_abort_pr (_("Unexpected error_node parameter"));
        COBC_ABORT ();
    }

    if (inside_check != 0) {
        if (inside_stack[inside_check - 1] != 0) {
            inside_stack[inside_check - 1] = 0;
            output (",\n");
        }
    }

    switch (CB_TREE_TAG (x)) {
    case CB_TAG_STATEMENT:
        p = CB_STATEMENT (x);
        /* Output source location as a comment */
        if (p->name) {
            output_newline ();
            output_line ("/* Line: %-10d: %-19.19s: %s */",
                     x->source_line, p->name, x->source_file);
        }
        if (x->source_file) {
            if (cb_flag_source_location) {
                /* Output source location as code */
                output_trace_info (x, p);
            }
            if (current_prog->flag_gen_debug &&
                !p->flag_in_debug) {
                output_prefix ();
                output ("memcpy (");
                output_data (cb_debug_line);
                output (", \"%6d\", 6);\n", x->source_line);
            }
            last_line = x->source_line;
        }

#if 0   /* RXWRXW - Exception */
        if (p->handler1 || p->handler2 ||
            (p->file && CB_EXCEPTION_ENABLE (COB_EC_I_O))) {
#else
        if (!p->file && (p->handler1 || p->handler2)) {
#endif
            output_line ("cob_glob_ptr->cob_exception_code = 0;");
        }

        if (p->null_check) {
            output_stmt (p->null_check);
        }

        if (p->body) {
            output_stmt (p->body);
        }

        /* Output field debugging statements */
        if (current_prog->flag_gen_debug && p->debug_check) {
            output_stmt (p->debug_check);
        }

        /* Special debugging callback for START / DELETE */
        /* Must be done immediately after I/O and before */
        /* status check */
        if (current_prog->flag_gen_debug && p->file && p->flag_callback) {
            output_line ("save_exception_code = cob_glob_ptr->cob_exception_code;");
            output_stmt (cb_build_debug (cb_debug_name,
                     CB_FILE(p->file)->name, NULL));
            output_move (cb_space, cb_debug_contents);
            output_perform_call (CB_FILE(p->file)->debug_section,
                         CB_FILE(p->file)->debug_section);
            output_line ("cob_glob_ptr->cob_exception_code = save_exception_code;");
            need_save_exception = 1;
        }

        if (p->handler1 || p->handler2 ||
            (p->file && CB_EXCEPTION_ENABLE (COB_EC_I_O))) {
            code = CB_EXCEPTION_CODE (p->handler_id);
            if (p->file) {
                output_ferror_stmt (p, code);
            } else {
                if (p->handler1) {
                    if ((code & 0x00ff) == 0) {
                        output_line ("if (unlikely((cob_glob_ptr->cob_exception_code & 0xff00) == 0x%04x))",
                             code);
                    } else {
                        output_line ("if (unlikely(cob_glob_ptr->cob_exception_code == 0x%04x))", code);
                    }
                    output_indent ("{");
                    output_stmt (p->handler1);
                    output_indent ("}");
                    if (p->handler2) {
                        output_line ("else");
                    }
                }
                if (p->handler2) {
                    if (p->handler1 == NULL) {
                        output_line ("if (!cob_glob_ptr->cob_exception_code)");
                    }
                    output_indent ("{");
                    output_stmt (p->handler2);
                    output_indent ("}");
                }
            }
        }
        break;
    case CB_TAG_LABEL:
        lp = CB_LABEL (x);
        if (lp->flag_skip_label) {
            break;
        }
        output_label_info (x, lp);
        if (lp->flag_section) {
            for (pal = lp->para_label; pal; pal = pal->next) {
                if (pal->para->segment > 49 &&
                    pal->para->flag_alter) {
                    output_line ("label_%s%d = 0;",
                             CB_PREFIX_LABEL, pal->para->id);
                }
            }
            last_segment = lp->segment;
            last_section = lp;
        }
        if (lp->flag_begin) {
            output_line ("%s%d:;", CB_PREFIX_LABEL, lp->id);
        }

        /* Check for runtime debug flag */
        if (current_prog->flag_debugging && lp->flag_is_debug_sect) {
            output_line ("if (!cob_debugging_mode)");
            output_line ("\tgoto %s%d;",
                CB_PREFIX_LABEL, CB_LABEL (lp->exit_label)->id);
        }

        if (cb_flag_trace) {
            output_section_info (lp);
        }

        /* Check procedure debugging */
        if (current_prog->flag_gen_debug && lp->flag_real_label) {
            output_stmt (cb_build_debug (cb_debug_name,
                     (const char *)lp->name, NULL));
            if (current_prog->all_procedure) {
                output_perform_call (current_prog->all_procedure,
                             current_prog->all_procedure);
            } else if (lp->flag_debugging_mode) {
                output_perform_call (lp->debug_section,
                             lp->debug_section);
            }
        }

        /* Check ALTER processing */
        if (lp->flag_alter) {
            output_alter_check (lp);
        }

        break;
    case CB_TAG_FUNCALL:
        output_prefix ();
        output_funcall (x);
        if (inside_check == 0) {
            output (";\n");
        } else {
            inside_stack[inside_check - 1] = 1;
        }
        break;
    case CB_TAG_ASSIGN:
        ap = CB_ASSIGN (x);
#ifdef  COB_NON_ALIGNED
        /* Nonaligned */
        if (CB_TREE_CLASS (ap->var) == CB_CLASS_POINTER ||
            CB_TREE_CLASS (ap->val) == CB_CLASS_POINTER) {
            /* Pointer assignment */
            output_indent ("{");
            output_line ("void *temp_ptr;");

            /* temp_ptr = source address; */
            output_prefix ();
            if (ap->val == cb_null || ap->val == cb_zero) {
                /* MOVE NULL ... */
                output ("temp_ptr = 0;\n");
            } else if (CB_TREE_TAG (ap->val) == CB_TAG_CAST) {
                /* MOVE ADDRESS OF val ... */
                cp = CB_CAST (ap->val);
                output ("temp_ptr = ");
                switch (cp->cast_type) {
                case CB_CAST_ADDRESS:
                    output_data (cp->val);
                    break;
                case CB_CAST_PROGRAM_POINTER:
                    output ("cob_call_field (");
                    output_param (ap->val, -1);
                    if (current_prog->nested_prog_list) {
                        gen_nested_tab = 1;
                        output (", cob_nest_tab, 0, %d)",
                            cb_fold_call);
                    } else {
                        output (", NULL, 0, %d)",
                            cb_fold_call);
                    }
                    break;
                default:
                    cobc_abort_pr (_("Unexpected cast type %d"),
                            cp->cast_type);
                    COBC_ABORT ();
                }
                output (";\n");
            } else {
                /* MOVE val ... */
                output ("memcpy(&temp_ptr, ");
                output_data (ap->val);
                output (", sizeof(temp_ptr));\n");
            }

            /* Destination address = temp_ptr; */
            output_prefix ();
            if (CB_TREE_TAG (ap->var) == CB_TAG_CAST) {
                /* SET ADDRESS OF var ... */
                cp = CB_CAST (ap->var);
                if (cp->cast_type != CB_CAST_ADDRESS) {
                    cobc_abort_pr (_("Unexpected tree type %d"),
                            cp->cast_type);
                    COBC_ABORT ();
                }
                output_data (cp->val);
                output (" = temp_ptr;\n");
            } else {
                /* MOVE ... TO var */
                output ("memcpy(");
                output_data (ap->var);
                output (", &temp_ptr, sizeof(temp_ptr));\n");
            }

            output_indent ("}");
        } else {
            /* Numeric assignment */
            output_prefix ();
            output_integer (ap->var);
            output (" = ");
            output_integer (ap->val);
            if (inside_check == 0) {
                output (";\n");
            } else {
                inside_stack[inside_check - 1] = 1;
            }
        }
#else   /* Nonaligned */
        output_prefix ();
        output_integer (ap->var);
        output (" = ");
        output_integer (ap->val);
        if (inside_check == 0) {
            output (";\n");
        } else {
            inside_stack[inside_check - 1] = 1;
        }
#endif  /* Nonaligned */
        break;
    case CB_TAG_INITIALIZE:
        output_initialize (CB_INITIALIZE (x));
        break;
    case CB_TAG_SEARCH:
        output_search (CB_SEARCH (x));
        break;
    case CB_TAG_CALL:
        output_call (CB_CALL (x));
        break;
    case CB_TAG_GOTO:
        output_goto (CB_GOTO (x));
        break;
    case CB_TAG_CANCEL:
        output_cancel (CB_CANCEL (x));
        break;
    case CB_TAG_SET_ATTR:
        sap = CB_SET_ATTR (x);
        output_set_attribute (sap->fld, sap->val_on, sap->val_off);
        break;
    case CB_TAG_ALTER:
        output_alter (CB_ALTER (x));
        break;
    case CB_TAG_IF:
        ip = CB_IF (x);
        if (!ip->is_if) {
            output_newline ();
            output_line ("/* WHEN */");
            output_newline ();
        }
        gen_if_level++;
        code = 0;
        output_prefix ();
        output ("if (");
        output_cond (ip->test, 0);
        output (")\n");
        output_line ("{");
        output_indent_level += 2;
        if (ip->stmt1) {
            output_stmt (ip->stmt1);
        } else {
            output_line ("; /* Nothing */");
        }
        if (gen_if_level > cb_if_cutoff) {
            if (ip->stmt2) {
                code = cb_id++;
                output_line ("goto l_%d;", code);
            }
        }
        output_indent_level -= 2;
        output_line ("}");
        if (ip->stmt2) {
            if (gen_if_level <= cb_if_cutoff) {
                output_line ("else");
                output_line ("{");
                output_indent_level += 2;
            }
            if (ip->is_if) {
                output_line ("/* ELSE */");
            } else {
                output_line ("/* WHEN */");
            }
            output_stmt (ip->stmt2);
            if (gen_if_level <= cb_if_cutoff) {
                output_indent_level -= 2;
                output_line ("}");
            } else {
                output_line ("l_%d:;", code);
            }
        }
        gen_if_level--;
        break;
    case CB_TAG_PERFORM:
        output_perform (CB_PERFORM (x));
        break;
    case CB_TAG_CONTINUE:
        output_prefix ();
        output (";\n");
        break;
    case CB_TAG_LIST:
        if (cb_flag_extra_brace) {
            output_indent ("{");
        }
        for (; x; x = CB_CHAIN (x)) {
            output_stmt (CB_VALUE (x));
        }
        if (cb_flag_extra_brace) {
            output_indent ("}");
        }
        break;
    case CB_TAG_REFERENCE:
        output_stmt (CB_REFERENCE(x)->value);
        break;
    case CB_TAG_DIRECT:
        if (CB_DIRECT (x)->flag_is_direct) {
            if (CB_DIRECT (x)->flag_new_line) {
                output_newline ();
            }
            output_line ("%s", (const char *)(CB_DIRECT (x)->line));
        } else {
            output_newline ();
            output_line ("/* %s */", (const char *)(CB_DIRECT (x)->line));
        }
        break;
    case CB_TAG_DEBUG:
        if (!current_prog->flag_gen_debug) {
            break;
        }
        output_prefix ();
        size = cb_code_field (CB_DEBUG(x)->target)->size;
        if (CB_DEBUG(x)->value) {
            if (size <= CB_DEBUG(x)->size) {
                output ("memcpy (");
                output_data (CB_DEBUG(x)->target);
                output (", %s%d, %d);\n", CB_PREFIX_STRING,
                    lookup_string (CB_DEBUG(x)->value),
                    (int)size);
            } else {
                output ("memcpy (");
                output_data (CB_DEBUG(x)->target);
                output (", %s%d, %d);\n", CB_PREFIX_STRING,
                    lookup_string (CB_DEBUG(x)->value),
                    (int)CB_DEBUG(x)->size);
                output_prefix ();
                output ("memset (");
                output_data (CB_DEBUG(x)->target);
                code = (int)(size - CB_DEBUG(x)->size);
                output (" + %d, ' ', %d);\n",
                    (int)CB_DEBUG(x)->size, code);

            }
        } else {
            if (size <= CB_DEBUG(x)->size) {
                output ("memcpy (");
                output_data (CB_DEBUG(x)->target);
                output (", ");
                output_data (CB_DEBUG(x)->fld);
                output (", %d);\n", (int)size);
            } else {
                output ("memcpy (");
                output_data (CB_DEBUG(x)->target);
                output (", ");
                output_data (CB_DEBUG(x)->fld);
                output (", %d);\n", (int)CB_DEBUG(x)->size);
                output_prefix ();
                output ("memset (");
                output_data (CB_DEBUG(x)->target);
                code = (int)(size - CB_DEBUG(x)->size);
                output (" + %d, ' ', %d);\n",
                    (int)CB_DEBUG(x)->size, code);
            }
        }
        break;
    case CB_TAG_DEBUG_CALL:
        output_perform_call (CB_DEBUG_CALL(x)->target,
                     CB_DEBUG_CALL(x)->target);
        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 output_storage ( const char *  fmt,   ...  )

static

Definition at line 515 of file codegen.c.

References cb_storage_file.

Referenced by codegen(), and output_file_allocation().

{
    va_list     ap;

    if (cb_storage_file) {
        va_start (ap, fmt);
        vfprintf (cb_storage_file, fmt, ap);
        va_end (ap);
    }
}

Here is the caller graph for this function:

static void output_string ( const unsigned char *  s, const int  size, const cob_u32_t  llit  )

static

Definition at line 489 of file codegen.c.

References output().

Referenced by codegen(), output_call(), output_cancel(), output_data(), output_initialize_literal(), output_initialize_one(), and output_param().

{
    int i;
    int c;

    if (!s) {
        output ("NULL");
        return;
    }
    output ("\"");
    for (i = 0; i < size; i++) {
        c = s[i];
        if (!isprint (c)) {
            output ("\\%03o", c);
        } else if (c == '\"') {
            output ("\\%c", c);
        } else if ((c == '\\' || c == '?') && !llit) {
            output ("\\%c", c);
        } else {
            output ("%c", c);
        }
    }
    output ("\"");
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void output_trace_info ( cb_tree  x, struct cb_statement *  p  )

static

Definition at line 4564 of file codegen.c.

References CB_PREFIX_STRING, excp_current_paragraph, excp_current_section, lookup_string(), cb_statement::name, output(), output_prefix(), cb_tree_common::source_file, and cb_tree_common::source_line.

Referenced by output_stmt().

{
    output_prefix ();
    output ("cob_set_location (%s%d, %d, ",
        CB_PREFIX_STRING,
        lookup_string (x->source_file),
        x->source_line);
    if (excp_current_section) {
        output ("%s%d, ",
            CB_PREFIX_STRING, lookup_string (excp_current_section));
    } else {
        output ("NULL, ");
    }
    if (excp_current_paragraph) {
        output ("%s%d, ",
            CB_PREFIX_STRING, lookup_string (excp_current_paragraph));
    } else {
        output ("NULL, ");
    }
    if (p->name) {
        output ("%s%d);\n",
            CB_PREFIX_STRING, lookup_string (p->name));
    } else {
        output ("NULL);\n");
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static struct cb_field* real_field_founder ( const struct cb_field *  f )

static

Definition at line 541 of file codegen.c.

References cb_field::parent, and cb_field::redefines.

Referenced by output_base(), and output_param().

{
    const struct cb_field       *ff;

    ff = f;
    while (ff->parent) {
        ff = ff->parent;
    }
    if (ff->redefines) {
        return ff->redefines;
    }
    return (struct cb_field *)ff;
}

Here is the caller graph for this function:

static struct string_list* string_list_reverse ( struct string_list *  p )

static

Definition at line 284 of file codegen.c.

References string_list::next, and NULL.

Referenced by codegen().

{
    struct string_list  *next;
    struct string_list  *last;

    last = NULL;
    for (; p; p = next) {
        next = p->next;
        p->next = last;
        last = p;
    }
    return last;
}

Here is the caller graph for this function:

static char* user_func_upper ( const char *  func )

static

Definition at line 914 of file codegen.c.

References cb_encode_program_id(), and cob_u8_t.

Referenced by output_param().

{
    unsigned char   *s;
    char        *rets;

    rets = cb_encode_program_id (func);
    for (s = (unsigned char *)rets; *s; s++) {
        if (islower ((int)*s)) {
            *s = (cob_u8_t)toupper ((int)*s);
        }
    }
    return rets;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

struct attr_list* attr_cache = ((void*)0)

static

Definition at line 121 of file codegen.c.

Referenced by lookup_attr().

struct base_list* base_cache = ((void*)0)

static

Definition at line 127 of file codegen.c.

Referenced by output_base().

struct call_list* call_cache = ((void*)0)

static

Definition at line 125 of file codegen.c.

Referenced by lookup_call().

FILE* cb_local_file = ((void*)0)

static

Definition at line 136 of file codegen.c.

Referenced by codegen(), and output_local().

struct cb_program* current_prog = ((void*)0)

static

Definition at line 140 of file codegen.c.

const char* excp_current_paragraph = ((void*)0)

static

Definition at line 139 of file codegen.c.

Referenced by codegen(), output_label_info(), and output_trace_info().

const char* excp_current_program_id = ((void*)0)

static

Definition at line 137 of file codegen.c.

Referenced by codegen(), output_base(), output_internal_function(), and output_param().

const char* excp_current_section = ((void*)0)

static

Definition at line 138 of file codegen.c.

Referenced by codegen(), output_label_info(), and output_trace_info().

struct field_list* field_cache = ((void*)0)

static

Definition at line 123 of file codegen.c.

Referenced by output_param().

cob_u32_t field_iteration = 0

static

Definition at line 166 of file codegen.c.

Referenced by output_call(), and output_data().

struct call_list* func_call_cache = ((void*)0)

static

Definition at line 126 of file codegen.c.

Referenced by lookup_func_call().

unsigned int gen_alt_ebcdic = 0

static

Definition at line 150 of file codegen.c.

Referenced by codegen(), and output_param().

unsigned int gen_custom = 0

static

Definition at line 154 of file codegen.c.

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

unsigned int gen_dynamic = 0

static

Definition at line 156 of file codegen.c.

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

unsigned int gen_ebcdic_ascii = 0

static

Definition at line 151 of file codegen.c.

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

unsigned int gen_figurative = 0

static

Definition at line 155 of file codegen.c.

Referenced by codegen(), and output_param().

unsigned int gen_full_ebcdic = 0

static

Definition at line 152 of file codegen.c.

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

int gen_if_level = 0

static

Definition at line 173 of file codegen.c.

Referenced by codegen(), and output_stmt().

unsigned int gen_native = 0

static

Definition at line 153 of file codegen.c.

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

unsigned int gen_nested_tab = 0

static

Definition at line 149 of file codegen.c.

Referenced by codegen(), output_call(), output_cancel(), output_integer(), output_long_integer(), and output_stmt().

struct base_list* globext_cache = ((void*)0)

static

Definition at line 128 of file codegen.c.

Referenced by output_internal_function().

unsigned int i_counters[16]

static

Definition at line 179 of file codegen.c.

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

unsigned int inside_check = 0

static

Definition at line 176 of file codegen.c.

Referenced by codegen(), output_cond(), output_param(), and output_stmt().

unsigned int inside_stack[64]

static

Definition at line 177 of file codegen.c.

Referenced by codegen(), output_cond(), output_param(), and output_stmt().

struct label_list* label_cache = ((void*)0)

static

Definition at line 132 of file codegen.c.

Referenced by output_perform_call().

int last_line = 0

static

Definition at line 165 of file codegen.c.

Referenced by codegen(), and output_stmt().

struct cb_label* last_section = ((void*)0)

static

Definition at line 142 of file codegen.c.

int last_segment = 0

static

Definition at line 172 of file codegen.c.

Referenced by codegen(), output_goto_1(), output_perform_call(), and output_stmt().

unsigned char* litbuff = ((void*)0)

static

Definition at line 143 of file codegen.c.

Referenced by output_initialize_one().

struct literal_list* literal_cache = ((void*)0)

static

Definition at line 122 of file codegen.c.

Referenced by lookup_literal().

int litsize = 0

static

Definition at line 144 of file codegen.c.

Referenced by output_initialize_one().

struct base_list* local_base_cache = ((void*)0)

static

Definition at line 129 of file codegen.c.

Referenced by output_base().

struct field_list* local_field_cache = ((void*)0)

static

Definition at line 124 of file codegen.c.

Referenced by output_param().

int local_mem = 0

static

Definition at line 168 of file codegen.c.

Referenced by codegen(), and output_internal_function().

int local_working_mem = 0

static

Definition at line 170 of file codegen.c.

Referenced by codegen(), and output_internal_function().

int loop_counter = 0

static

Definition at line 163 of file codegen.c.

Referenced by codegen(), and output_perform().

unsigned int need_save_exception = 0

static

Definition at line 148 of file codegen.c.

Referenced by codegen(), and output_stmt().

unsigned int needs_exit_prog = 0

static

Definition at line 146 of file codegen.c.

Referenced by codegen(), output_call(), output_goto(), and output_internal_function().

unsigned int needs_unifunc = 0

static

Definition at line 147 of file codegen.c.

Referenced by codegen(), and output_call().

unsigned int nolitcast = 0

static

Definition at line 174 of file codegen.c.

Referenced by output_funcall(), and output_param().

int non_nested_count = 0

static

Definition at line 162 of file codegen.c.

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

int num_cob_fields = 0

static

Definition at line 161 of file codegen.c.

Referenced by codegen(), and output_param().

int output_indent_level = 0

static

Definition at line 171 of file codegen.c.

Referenced by codegen(), output_call(), output_goto(), output_indent(), output_param(), output_prefix(), output_search_whens(), and output_stmt().

FILE* output_target = ((void*)0)

static

Definition at line 135 of file codegen.c.

Referenced by codegen(), lookup_literal(), output_internal_function(), output_line(), output_newline(), output_param(), and output_prefix().

int param_id = 0

static

Definition at line 158 of file codegen.c.

Referenced by codegen(), output_func_1(), and output_param().

int progid = 0

static

Definition at line 164 of file codegen.c.

Referenced by codegen(), and output_entry_function().

int screenptr = 0

static

Definition at line 167 of file codegen.c.

Referenced by output_funcall(), and output_param().

int stack_id = 0

static

Definition at line 159 of file codegen.c.

Referenced by codegen(), output_param(), and output_stmt().

char* string_buffer = ((void*)0)

static

Definition at line 131 of file codegen.c.

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

struct string_list* string_cache = ((void*)0)

static

Definition at line 130 of file codegen.c.

Referenced by lookup_string().

int string_id

static

Definition at line 160 of file codegen.c.

Referenced by codegen(), and lookup_string().

const struct system_table system_tab[]

static

Definition at line 184 of file codegen.c.

int working_mem = 0

static

Definition at line 169 of file codegen.c.

Referenced by codegen(), and output_internal_function().