/*
 * Copyright (C) 2005, David Essex, Rildo Pragana.
 * Copyright (C) 2003, Rildo Pragana, Bernard Giroud.
 * Copyright (C) 2002, 2001, 2000, 1999,  Rildo Pragana, Jim Noeth,
 *               David Essex, Glen Colbert, Andrew Cameron.
 * Copyright (C) 1993, 1991  Rildo Pragana.
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2, or (at your option)
 *  any later version.
 *  
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *  
 *  You should have received a copy of the GNU General Public License
 *  along with this software; see the file COPYING.  If not, write to
 *  the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 *  Boston, MA 02111-1307 USA
 */

/* 
 *    Assembler Code Generator for Cobol Compiler
 */

#include "htconfig.h"
#include "htversion.h"
#include "htcoboly.h"
#include "htcoblib.h"
#include "htglobals.h"
#include "mwindows.h"

//unsigned int gen_move_first(struct sym *sy, unsigned int loc, unsigned int size, unsigned int *idx); // walter 13-12-05
void gen_loaddesc2(struct sym *sy, int variable_length);

int pgm_segment = 0; /* # of program in source file */
int screen_io_enable = 0; /* use screen routines or not for accept/display */

int decimal_comma = 0; /* decimal char 1 = ',' ; 0 ='.' */
#define decimal_char() (decimal_comma ? ',' : '.')

char currency_symbol = '$';
char sch_convert_buf[512];

struct sym *screen_status_field = NULL; /* variable of crt status */
struct sym *cursor_field = NULL; /* variable of cursor */
struct lit *program_name_literal = NULL; /* literal thar holds the program name */

int stabs_on_sw = 0;

extern struct lextab literal;
extern int yydebug;
extern struct sym *curr_file;

struct sym *curr_paragr = NULL, *curr_section = NULL;
struct sym *curr_field;
short curr_call_mode = 0;
short curr_call_convention = 0;
unsigned stack_offset = 0; /* offset for variables on the stack */
/*#define SAVED_EBX_OFFSET 4*/ /* relative to %ebp */
unsigned stack_plus = 0;
unsigned global_offset = 4; /* offset for global variables (DATA) */
/*unsigned file_offset=0;*/
unsigned literal_offset = 0;
unsigned data_offset = 0;
/*#define data_offset global_offset*/
unsigned linkage_offset = 0;
unsigned using_offset = 8;
/* tmpvar_offset: for storage of temporary variables, 
with space reclaimed after the current instruction*/
unsigned tmpvar_offset = 0;
unsigned tmpvar_max = 0;

unsigned last_lineno = 0;
short at_procedure = 0;
short refmod_slots = 0;
static char name_buf[MAXNAMEBUF];

struct lit *spe_lit_ZE = NULL; /* figurative constant ZERO */
struct lit *spe_lit_SP = NULL; /* figurative constant SPACE */
struct lit *spe_lit_LV = NULL; /* figurative constant LOW-VALUE */
struct lit *spe_lit_HV = NULL; /* figurative constant HIGH-VALUE */
struct lit *spe_lit_QU = NULL; /* figurative constant QUOTE */
static char init_ctype; /* hold homogenous type */
static short init_val; /* hold homogenous value */
static struct init_str_tab *istrp;
static unsigned curr_01_location; /* hold current root father when set_field_location */

struct list *expr_list = NULL;
struct list *files_list = NULL;
struct list *disp_list = NULL;
struct parm_list *parameter_list = NULL;
struct list *fields_list = NULL;
struct list *last_field = NULL;
struct index_to_table_list *index2table = NULL;
struct named_sect *named_sect_list = NULL;
struct list *switches_list = NULL;
struct list *vars_list = NULL;
short next_available_sec_no = SEC_FIRST_NAMED;
short default_sec_no = SEC_WORKING;
short curr_sec_no = SEC_WORKING;

struct parm_list *chaining_list = NULL; /* chaining variables */

int screen_label = 0;
int para_label = 0;
int block_label = 0;
int line_label = 0;
int paragr_num = 1;
int loc_label = 1;
unsigned char picture[100]; /* for max 50 signs and counts */
int picix, piccnt, decimals, sign, v_flag, n_flag, digits, pscale;
int filler_num = 1;
int active[37];
int at_linkage = 0;
int stackframe_cnt = 0;
int inner_stack_size = 0;
#if !defined(__WINDOWS__)
char program_id[120] = "main";
char *pgm_label = "main";
#else
char program_id[120] = "_main";
char *pgm_label = "_main";
#endif
int initial_flag = 0;
struct list *report_list = NULL;
static int need_desc_length_cleanup = 0;
extern int stabs_started;


extern int main_flag; /* Does it have an main entry point */
extern int main_entry_flag; /* Specify main entry point */
extern char main_entry_buf[]; /* main entry point name */

int module_flag = 1; /* All (sub)programs are modules (routines) */
int nested_flag = 0; /* Is this program nested inside another program */
int has_linkage = 0; /* Has linkage section ? */
/*
 **        Symbol table management routines
 */

struct sym *vartab[ HASHLEN ] = {NULL};
struct sym *labtab[ HASHLEN ] = {NULL};
struct lit *littab[ HASHLEN ] = {NULL};

int
hash(char *s)
{
    int val;
    for (val = 0; *s != '\0';)
        val += (unsigned char) toupper(*s++); // walter coloquei (unsigned char)
    return ( val % HASHLEN);
}

char *
savename(char *s)
{
    char *ap;
    if ((ap = (char *) malloc(strlen(s) + 1)) != NULL)
        strcpy(ap, s);
    return ( ap);
}

char *
upcase(char *s, char *buf)
{
    char *t;
    int n = SYMBUF_SIZE - 1;
    t = buf;
    while (*s && n--)
    {
        *t++ = toupper(*s++);
    }
    if (n <= 0)
    {
        yyerror("Too large symbol");
    }
    *t = 0;
    return buf;
}

void
update_xreflist(struct sym *as)
{
    if ((as->xrefs.pos > 0) &&
            (as->xrefs.lineno[as->xrefs.pos - 1] == source_lineno))
        return;

    if (as->xrefs.size <= as->xrefs.pos)
    {
        as->xrefs.size += 10;
        as->xrefs.lineno = realloc(as->xrefs.lineno, sizeof (int) * as->xrefs.size);
    }
    as->xrefs.lineno[as->xrefs.pos] = source_lineno;
    as->xrefs.pos++;
}

struct sym *
lookup(char *s, int tab)
{
    char sbuf[SYMBUF_SIZE];
    if (tab == SYTB_LIT)
    { /* literals tab */
        struct lit *as;
        for (as = littab[ hash(s) ]; as != NULL; as = as->next)
            if (strcmp(s, as->name) == 0)
                return ( (struct sym *) as);
        return ( NULL);
    }
    else
    {
        struct sym *as;
        s = upcase(s, sbuf);
        if (tab == SYTB_VAR)
            as = vartab[ hash(s) ];
        else
            as = labtab[ hash(s) ];
        for (; as != NULL; as = as->next)
            if (strcmp(s, as->name) == 0)
                return ( as);
        return ( NULL);
    }
}

struct sym *
install(char *name, int tab, int cloning)
{
    char sbuf[SYMBUF_SIZE];
    struct sym *clone;
    struct sym *as;
    struct lit *al;
    int val;

    if (tab == SYTB_LIT)
    {
        al = (struct lit *) malloc(sizeof (struct lit));
        if (al == NULL)
            return NULL;
        if ((al->name = savename(name)) == NULL)
            return NULL;
        val = hash(al->name);
        al->next = littab[ val ];
        littab[ val ] = al;
        al->type = 0;
        al->all = 0;
        al->litflag = 1;
        al->nick = NULL;
        al->len = strlen(name);
        return ( (struct sym *) al);
    }
    else
    {
        name = upcase(name, sbuf);
        if ((as = lookup(name, tab)) == NULL)
        {
            as = (struct sym *) malloc(sizeof (struct sym));
            memset(as, 0, sizeof (struct sym));
            if (as == NULL)
                return NULL;
            if ((as->name = savename(name)) == NULL)
                return NULL;
            val = hash(as->name);
            if (tab == SYTB_VAR)
            {
                /* fprintf(stderr,"install: creating %s -> 0x%x\n",as->name,as); */
                as->next = vartab[ val ];
                vartab[ val ] = as;
            }
            else
            {
                as->next = labtab[ val ];
                labtab[ val ] = as;
            }
            as->type = 0;
            as->flags.is_pointer = 0;
            as->flags.just_r = 0;
            as->flags.separate_sign = 0;
            as->flags.leading_sign = 0;
            as->flags.blank = 0;
            as->flags.sync = 0;
            as->slack = 0;
            as->pscale = 0;
            as->defined = 0;
            as->value = as->sort_data = NULL;
            as->linkage_flg = 0;
            as->litflag = 0;
            as->scr = NULL;
            as->clone = as->parent = NULL;
            as->son = NULL;
            as->occurs = NULL;
            as->xrefs.size = 1;
            as->xrefs.pos = 0;
            as->xrefs.lineno = malloc(sizeof (int));
            as->xrefs.lineno[0] = 0;
        }
        else if ((cloning && (as->defined == 1)) || (cloning == 2))
        {
            /* install clone (cloning==2 -> force) */
            /* fprintf(stderr,"install: cloning %s -> 0x%x\n",as->name,as); */
            clone = (struct sym *) malloc(sizeof (struct sym));
            memset(clone, 0, sizeof (struct sym));
            if (clone == NULL)
                return NULL;
            clone->name = as->name;
            clone->type = 0;
            clone->flags.is_pointer = 0;
            clone->flags.just_r = 0;
            clone->flags.separate_sign = 0;
            clone->flags.leading_sign = 0;
            clone->flags.blank = 0;
            clone->flags.sync = 0;
            clone->slack = 0;
            clone->pscale = 0;
            clone->defined = 0;
            clone->value = as->sort_data = NULL;
            clone->linkage_flg = 0;
            clone->litflag = 0;
            clone->scr = NULL;
            clone->parent = NULL;
            clone->occurs = NULL;
            clone->clone = as->clone;
            as->clone = clone;
            as = clone;
        }
        return ( as);
    }
}

struct lit *
install_lit(char *name, int length, int all)
{
    struct lit *al;
    int val;

    /* if length was not given, take the length from the name string */
    if (length == 0)
    {
        length = strlen(name);
    }
    al = (struct lit *) malloc(sizeof (struct lit));
    if (al == NULL)
        return NULL;
    /* it is safer to null terminate it, so alloc one char more */
    al->name = malloc(length + 1);
    if (al->name == NULL)
    {
        return NULL;
    }
    memcpy(al->name, name, length);
    *(al->name + length) = 0;

    val = hash(al->name);
    al->next = littab[ val ];
    littab[ val ] = al;
    al->type = 0;
    al->all = all;
    al->litflag = 1;
    al->nick = NULL;
    al->len = length;
    return al;
}

struct sym *
lookup_label(struct sym *sy, struct sym *parent)
{

#if 0
#ifdef DEBUG_COMPILER
    fprintf(stderr, "lookup_label: %s", sy->name);
#endif
#endif
    while (sy->clone && (sy->parent != parent))
        sy = sy->clone;
    if (sy->parent == parent)
    {
#if 0
#ifdef DEBUG_COMPILER
        if (sy->parent != NULL)
            fprintf(stderr, " found -> %s\n", sy->parent->name);
        else
            fprintf(stderr, " found\n");
#endif
#endif
        return sy;
    }
    else
    {
#if 0
#ifdef DEBUG_COMPILER
        fprintf(stderr, " not found\n");
#endif
#endif
        return NULL;
    }
}

struct sym *
lookup_variable(struct sym *sy, struct sym *parent)
{
    struct sym *tmp;
    /* sy = lookup(sy->name,SYTB_VAR); */
    if (parent->litflag == 2)
    {
        parent = (struct sym *) ((struct vref *) parent)->sym;
    }
    while (1)
    {
        tmp = sy;
        while (tmp && tmp->parent != parent)
            tmp = tmp->parent;
        if (tmp && tmp->parent == parent)
            break;
        if (sy->clone == NULL)
            break;
        sy = sy->clone;
    }
    return sy;
}

struct sym *
lookup_parent(struct sym *sy, struct sym *parent)
{
    struct sym *tmp;
    if (parent->litflag == 2)
    {
        parent = (struct sym *) ((struct vref *) parent)->sym;
    }
    while (sy)
    {
        tmp = sy;
        while (tmp && tmp->parent != parent)
            tmp = tmp->parent;
        if (tmp && tmp->parent == parent)
            break;
        sy = sy->clone;
    }
    return sy;
}

struct sym *
lookup_for_redefines(struct sym *sy)
{
    struct sym *tmp;
    if (curr_field->parent == NULL)
    {
        tmp = lookup(sy->name, SYTB_VAR);
    }
    else
    {
        tmp = lookup_variable(sy, curr_field->parent);
    }
    return tmp;
}

void
clear_symtab()
{
    struct sym *sy, *sy1, *tmp;
    /* struct lit *lt,*lt1,*ltmp; */
    int i;
    for (i = 0; i < HASHLEN; i++)
    {
        for (sy1 = vartab[i]; sy1 != NULL;)
        {
            for (sy = sy1->clone; sy;)
            {
                if (sy)
                {
                    tmp = sy;
                    sy = sy->clone;
                    free(tmp);
                }
            }
            tmp = sy1;
            sy1 = sy1->next;
            free(tmp);
        }
        vartab[i] = NULL;
    }
    for (i = 0; i < HASHLEN; i++)
    {
        for (sy1 = labtab[i]; sy1 != NULL;)
        {
            for (sy = sy1->clone; sy;)
            {
                if (sy)
                {
                    tmp = sy;
                    sy = sy->clone;
                    free(tmp);
                }
            }
            tmp = sy1;
            sy1 = sy1->next;
            free(tmp);
        }
        labtab[i] = NULL;
    }
    /*for (i=0;i<HASHLEN;i++) {
        for (lt1=littab[i];lt1!=NULL;) {
                    ltmp = lt1;
                    lt1 = lt1->next;
                    free(ltmp);
        }
            littab[i] = NULL;
    }*/
}

/* clear_offset() is called when starting a new program segment */
void
clear_offsets()
{
    stack_offset = 0;
    global_offset = 4;
    literal_offset = 0;
    data_offset = 0;
    linkage_offset = 0;
    using_offset = 8;
    refmod_slots = 0;
    free_list(fields_list);
    fields_list = NULL;
    free_list(files_list);
    files_list = NULL;
    /* clear all current paragraphs/sections and fields */
    curr_paragr = NULL;
    curr_section = NULL;
    curr_field = NULL;
    /* free tmpvar storage */
    tmpvar_offset = 0;
    tmpvar_max = 0;
    stabs_started = 0;
}

/*** we need this because the literal string is already stored ***/
char
sign_to_char(int digit)
{
    char cDigit;
    if (!digit)
        cDigit = '}';
    else if (digit == 0x80)
        cDigit = '{';
    else if (digit > 0)
        cDigit = (char) ('A' + digit - 1);
    else
        cDigit = (char) ('J' - digit - 1);
    return cDigit;
}

void
invert_literal_sign(struct lit *sy)
{
    char *s = sy->name;
    int off = strlen(sy->name) - 1;
    s[off] = sign_to_char(-(s[off] - '0'));
}

void
check_decimal_point(struct lit *lit)
{
    char *s = lit->name;
    if ((decimal_comma && strchr(s, '.')) ||
            (!decimal_comma && strchr(s, ',')))
    {
        yyerror("wrong decimal point character in numeric literal");
    }
}

int
is_variable(struct sym *sy)
{
    int r = 0;
    if (sy->litflag == 0)
    {
        switch (sy->type)
        {
            case '8': /* 88 field */
            case DTYPE_DISPLAY: /* numeric */
            case DTYPE_ALPHA: /* alpha */
            case DTYPE_BININT: /* binary (comp/computational) */
            case DTYPE_PACKED: /* compacted (comp-3/comptational-3) */
            case DTYPE_ACCEPT_DISPLAY: /* screen data */
            case DTYPE_EDITED: /* edited */
            case DTYPE_GROUP: /* group */
            case DTYPE_FLOAT: /* float(comp-1 4 bytes) / double(comp-2 8 bytes) */
            case DTYPE_ALPHANUMERIC: /* alphanum */
                r = 1;
                break;
            default:
                r = 0;
                break;
        }
    }
    return r;
}

int
is_subscripted(struct sym *sy)
{
    if (sy->occurs_flg) /* the item itself "occurs" */
        return 1;
    while (sy->parent != NULL)
    { /* some parenr "occurs" */
        sy = sy->parent;
        if (sy->occurs_flg)
            return 1;
    }
    return 0;
}

int
adjust_linkage_vars(int start_offset)
{
    struct sym *sy, *sy1;
    int i;
    int offset = start_offset;

    for (i = 0; i < HASHLEN; i++)
    {
        for (sy1 = vartab[i]; sy1 != NULL; sy1 = sy1->next)
        {
            for (sy = sy1; sy; sy = sy->clone)
            {
                if (sy->parent == NULL && sy->linkage_flg == 1)
                {
                    sy->linkage_flg = -offset;
                    offset += 4;
                }
            }
        }
    }
    return offset;
}

/*
 *   Put a field to its initial value.
 *   It can be a value specified by 'value' or an initialization value
 *   If it is a group field, initialize all the fields under it. 
 */
static void
set_initial_value(struct sym *sy)
{
    int j, nb_fields;
    struct init_str init_templ;

    if (sy->redefines) return;
#ifdef DEBUG_COMPILER
    if (sy->value)
        fprintf(o_src, "#  initial value to field '%s' = '%s' \n",
            sy->name, sy->value->name);
    else
        fprintf(o_src, "#  initial value to field '%s', INITIALIZED \n",
            sy->name);
#endif
    /* Initialize a non-group field */
    if (sy->level == 77 || (sy->level == 1 && sy->son == NULL))
    {
        if (sy->value)
            gen_move_init((struct sym *) sy->value, sy); /* initial value */
        else
            gen_initialize(sy, 0); /* initialize at spaces or 0 */
        return;
    }

    /* Initialize a group to zero or blank */
    init_ctype = ' ';
    init_val = -1;
    nb_fields = get_nb_fields(sy, 1);
    if (init_ctype != '&' && init_ctype != ' ' && init_val > 1)
    {
        gen_init_str(sy, init_ctype, symlen(sy));
        return;
    }

    /* Initialize a group's fields one by one */
#ifdef DEBUG_COMPILER
    fprintf(o_src, "#  istrp = malloc(%d) nb_fields = %d\n",
            nb_fields * sizeof (init_templ), nb_fields);
#endif
    istrp = malloc(nb_fields * sizeof (init_templ));
    build_init_str(sy, nb_fields);
    for (j = 0; j < nb_fields; j++)
    {
        if (istrp->ent[j].value != NULL)
        {
            unsigned saved_loc = istrp->ent[j].sy->location;
            istrp->ent[j].sy->location = istrp->ent[j].location;
            gen_move_init((struct sym *) istrp->ent[j].sy->value
                    , istrp->ent[j].sy);
            istrp->ent[j].sy->location = saved_loc;
        }
    }
    free(istrp);
    istrp = NULL;
    return;
}

/*
 *  Initialize all the variables at the beginig of the program
 */
void
do_init_val()
{
    struct sym *sy, *sy1, *v;
    int i;
    char typ;
    for (i = 0; i < HASHLEN; i++)
        for (sy1 = vartab[i]; sy1 != NULL; sy1 = sy1->next)
            for (sy = sy1; sy != NULL; sy = sy->clone)
                if (sy->type != 'F' && sy->type != '8' &&
                        sy->type != 'K' && sy->type != 'J')
                {
                    v = sy;
                    typ = v->type;
                    if (typ == 'F' || typ == 'R' || typ == 'K' || typ == 'J'
                            || typ == '8')
                        continue;
                    /* Here only work with level 1 and 77 */
                    if (v->level != 1 && v->level != 77) continue;
                    /* Don't initialize fields in linkage */
                    if (v->linkage_flg) continue;

                    set_initial_value(v);
                }
}

void
save_field_in_list(struct sym *sy)
{
    struct list *list;
    if (fields_list == NULL)
    {
        list = (struct list *) malloc(sizeof (struct list));
        last_field = fields_list = list;
        list->next = NULL;
        list->var = sy;
    }
    else
    {
        list = (struct list *) malloc(sizeof (struct list));
        list->var = sy;
        list->next = NULL;
        last_field->next = list;
        last_field = list;
    }
}

void
save_literal(struct lit *v, int type)
{
    char *s;
    char *dp;
    int piclen;
    /* if (v->type) return; */ /* already saved */
    s = v->name;
    piclen = 3; /* assume 'X'-only literal */
    if ((type == DTYPE_DISPLAY) && (*(v->name + v->len - 1) > '9'))
    {
        piclen += 2; /* we need space for the sign picture char */
    }
    if (type != DTYPE_ALPHANUMERIC && (dp = strchr(s, decimal_char())) != NULL)
    {
        piclen += 4; /* reserve space for 'V' and decimal part */
        v->decimals = v->len - (int) (dp - s) - 1;
    }
    else v->decimals = 0;
    /*        v->pscale=0; */
    if (type == DTYPE_ALPHANUMERIC && v->len > 255)
    {
        piclen += (v->len / 255)*2;
    }
    v->type = type;
    /****** save literal in fields list for later *******/
    save_field_in_list((struct sym *) v);
    /******** save address of const string ************/
    v->location = literal_offset;
    v->sec_no = SEC_CONST;
    if (v->decimals)
        literal_offset += v->len;
        /* it's already one chr larger (decimal point) */
    else
        literal_offset += v->len + 1;
    /******** save address of field descriptor ********/
    v->descriptor = literal_offset;
    literal_offset += HTG_fld_desc_len + piclen;
    /* printf("save_literal: name=%s, type=%c, offset=%x, piclen=%d\n",
            v->name, v->type, v->descriptor, piclen); */
}

void
save_named_sect(struct sym *sy)
{
    /*char *s;
    char *dp;*/
    struct named_sect *nsp;
    nsp = (struct named_sect *) malloc(sizeof (struct named_sect));
    sy->flags.external = 1;
    nsp->sec_no = next_available_sec_no++;
    /*        nsp->os_name = sy->name; walter...why these ??? */
    nsp->os_name = (char *) malloc(strlen(nsp->os_name) + 1);
    strcpy(nsp->os_name, sy->name);
    chg_underline(nsp->os_name);
    nsp->next = named_sect_list;
    named_sect_list = nsp;
    curr_sec_no = nsp->sec_no;
    sy->sec_no = curr_sec_no;
}

struct lit *
save_special_literal(char val, char picc, char *nick)
{
    struct lit *v;
    v = (struct lit *) install(nick, SYTB_LIT, 0);
    if (v->type) return NULL; /* already saved */
    v->decimals = 0;
    /*        v->pscale=0; */
    v->type = picc;
    v->nick = (char *) malloc(2);
    v->nick[0] = val;
    v->nick[1] = 0;
    v->len = 1;
    v->all = 0;
    save_field_in_list((struct sym *) v);
    v->location = literal_offset;
    v->sec_no = SEC_CONST;
    literal_offset += 2; /* we have only 1-char special literals */
    v->descriptor = literal_offset;
    literal_offset += (HTG_fld_desc_len + 3);
    return v;
}

void
define_switch_field(struct sym *sy, struct sym *sy2)
{

    curr_field = NULL;
    define_field(77, sy);
    curr_field->len = 2;
    curr_field->type = DTYPE_BININT;
    curr_field->decimals = 0;
    picture[0] = '9';
    picture[1] = 4;
    picture[2] = 0;
    curr_field->ix_desc = sy2;
    update_field(curr_field);
    sy2->defined = 1; /* switch number is implicitly defined */
    switches_list = insert_list(switches_list, sy);
}

struct lit *
define_num_lit(int value)
{
    char tblmax[21];
    struct lit *v;

    sprintf(tblmax, "%d", value);
    v = (struct lit *) install(tblmax, SYTB_LIT, 0);
    save_literal(v, DTYPE_DISPLAY);
    return v;
}

void
save_switch_value(struct sym *sy, int value)
{
    struct lit *v;

    v = define_num_lit(value);
    define_field(88, sy);
    sy->value = v;
    sy->value2 = v;
}

void
put_disp_list(struct sym *sy)
{
    struct list *list, *tmp;
#if 0
    if ((!(sy->defined)) && (sy->litflag != 1))
    {
        yyerror("variable %s not defined", sy->name);
    }
#endif
    /* fprintf(o_src,"# put_disp_list: %s\n",sy->name); */
    list = (struct list *) malloc(sizeof (struct list));
    list->var = sy;
    list->next = NULL;
    if (disp_list == NULL)
        disp_list = list;
    else
    {
        tmp = disp_list;
        while (tmp->next != NULL) tmp = tmp->next;
        tmp->next = list;
    }
}

int
pic_digits(struct sym *sy, char target)
{
    char *p = NULL;
    int len = 0;
    if (sy == NULL)
        return 0;
    if (sy->litflag)
    {
        len = strlen(sy->name);
        if (strchr(sy->name, decimal_char())) len--;
        if (strchr(sy->name, '+')) len--;
        if (strchr(sy->name, '-')) len--;
        /* printf("pic_digits: %s -> %d\n",sy->name,len); */
        return len;
    }
    else
    {
        p = sy->picstr;
        while (*p)
        {
            if (*p++ == target)
            {
                len += *p++;
            }
            else
                p++;
        }
    }
    /* printf("pic_digits: %s -> %d\n",sy->name,len); */
    return len;
}

/* Return the maximum length which might be occupied by a corresponding value */
int
get_max_edt_len(struct sym * sy)
{
    int plen;
    /*walter*/
    if (sy->type == DTYPE_BININT)
        return (sy->len * 3);
    /*fimwalter*/
    if (sy->type == DTYPE_ALPHANUMERIC || sy->type == DTYPE_ALPHA ||
            sy->type == DTYPE_EDITED || sy->type == DTYPE_GROUP ||
            sy->type == DTYPE_ALPHANUMERICL || sy->type == DTYPE_ACCEPT_DISPLAY)
    {
        plen = sy->len;
    }
    else
    {
        plen = pic_digits(sy, '9');
        if (sy->picstr[0] == 'S') plen++;
        if (sy->decimals > 0) plen++;
        if (sy->pscale != 0) plen = plen + abs(sy->pscale);
    }
    return plen;
}

int
query_comp_len(struct sym * sy)
{
    int plen;
//    char target = '9';

    if (sy->stype == 'X')
    {
//        target = 'X';
        plen = pic_digits(sy, 'X');
        /* for the time being, picture is altered just before output
           in htcobemt.c */
        /* strcpy(sy->picstr,"9\xa"); */ /* max picture for 4 bytes */
        return plen;
    }
    else
    {
        if ((plen = pic_digits(sy, '9')) <= 2)
            return 1;
        if (plen <= 4)
            return 2;
        if (plen <= 9)
            return 4;
        return 8;
    }
}

int
symlen(struct sym *sy)
{
    /*int plen;*/
    if (sy->type == DTYPE_PACKED)
        return sy->len / 2 + 1;
    else if (sy->litflag == 1)
        return ((struct lit *) sy)->len;
    return sy->len;
}

/* Returns the minimum number of 9 to hold a complete value */
int
sym_min_pic(struct sym *sy)
{

    if (sy->type != DTYPE_BININT)
        return sy->len;
    if (sy->stype != 'X')
        return pic_digits(sy, '9');
    switch (symlen(sy))
    {
        case 1: return 3;
        case 2: return 5;
        case 4: return 10;
        case 8: return 19;
    }
    return pic_digits(sy, '9');
}

void
add_alternate_key(struct sym *sy, int duplicates)
{
    struct sym *f = curr_file;
    struct alternate_list *alt, *new;
    alt = (struct alternate_list *) f->alternate;
    new = malloc(sizeof (struct alternate_list));
    new->next = alt;
    new->key = sy;
    new->duplicates = duplicates;
    f->alternate = (struct sym *) new;
}

struct list *
insert_list(struct list *l, void *item)
{
    struct list *tmp;
    if (l == NULL)
    {
        l = malloc(sizeof (struct list));
        l->var = item;
        l->next = NULL;
    }
    else
    {
        for (tmp = l; tmp->next != NULL; tmp = tmp->next);
        tmp->next = malloc(sizeof (struct list));
        tmp->next->var = item;
        tmp->next->next = NULL;
    }
    return l;
}

struct gvar_list *
gvar_list_append(struct gvar_list *l, struct sym *item, int linenum)
{
    struct gvar_list *tmp;

    if (l == NULL)
    {
        tmp = malloc(sizeof (struct gvar_list));
        l = tmp;
    }
    else
    {
        for (tmp = l; tmp->next != NULL; tmp = tmp->next);
        tmp->next = malloc(sizeof (struct gvar_list));
        tmp = tmp->next;
    }
    tmp->u.sym = item;
    tmp->attribute = linenum;
    tmp->next = NULL;

    return l;
}

void
sort_keys_append(struct sym *fname, struct gvar_list *l)
{
    struct gvar_list *gvar_w1, *gvar_w2;
    struct sym *sym_wk;

    for (gvar_w1 = l; gvar_w1 != NULL; gvar_w1 = gvar_w1->next)
    {
        for (gvar_w2 = gvar_w1->u.gvar; gvar_w2 != NULL; gvar_w2 = gvar_w2->next)
        {
            sym_wk = gvar_w2->u.sym;
            sym_wk->direction = gvar_w1->attribute;
            sym_wk->sort_data = fname->sort_data;
            /* fname->sort_data = sym_wk; */
            fname->sort_data = (void *) sym_wk;
        }
    }
}

struct gvar_list *
sort_key_list_create(struct gvar_list *item, int atrbt)
{
    struct gvar_list *l;

    l = malloc(sizeof (struct gvar_list));
    l->u.gvar = item;
    l->attribute = atrbt;
    l->next = NULL;

    return l;
}

struct gvar_list *
sort_keys_list_append(struct gvar_list *l, struct gvar_list *item)
{
    struct gvar_list *tmp;

    if (l == NULL)
    {
        l = item;
    }
    else
    {
        for (tmp = l; tmp->next != NULL; tmp = tmp->next);
        tmp->next = item;
    }

    return l;
}

void
free_list(struct list *l)
{
    struct list *tmp;
    while (l != NULL)
    {
        tmp = l->next;
        free(l);
        l = tmp;
    }
    l = NULL;
}

void
mark_decl_list(struct list *l)
{
    struct list *tmp;
    while (l != NULL)
    {
        ((struct sym *) l->var)->refmod_redef.declarative = curr_section;
        tmp = l->next;
        free(l);
        l = tmp;
    }
}

struct scr_info *
alloc_scr_info()
{
    struct scr_info *new;
    struct scr_info *parent_info = NULL;

    if (curr_field && curr_field->parent)
        parent_info = curr_field->parent->scr;

    new = malloc(sizeof (struct scr_info));
    new->attr = 0;
    new->line = 0;
    new->column = 0;
    new->foreground = NULL;
    new->background = NULL;
    new->color = NULL;
    new->line_var = NULL;
    new->column_var = NULL;
    new->from = NULL;
    new->to = NULL;
    new->line_sign = 0;
    new->column_sign = 0;
    new->size = NULL;

    if (parent_info) /* If exists copy information from parent field */
    {
        new->attr = parent_info->attr;
        new->foreground = parent_info->foreground;
        new->background = parent_info->background;
        new->color = parent_info->color;
        /* new->line = parent_info->line; */
        /* new->column = parent_info->column; */
        /* new->line_var = parent_info->line_var; */
        /* new->column_var = parent_info->column_var; */
        /* new->line_sign = parent_info->line_sign; */
        /* new->column_sign = parent_info->column_sign; */
    }
    if (parent_info && curr_field->parent->son != curr_field)
    {
        new->line = new->column = 0;
        new->line_var = new->column_var = NULL;
        new->line_sign = new->column_sign = 0;
    }
    return new;
}

struct inspect_before_after *
alloc_inspect_before_after(struct inspect_before_after *ba,
        int before_after, struct sym *var)
{
    if (ba == NULL)
    {
        ba = malloc(sizeof (struct inspect_before_after));
        ba->before = ba->after = NULL;
    }
    if (before_after == 1)
    { /* before given */
        if (ba->before)
        {
            yyerror("only one BEFORE phrase can be given");
        }
        else
        {
            ba->before = var;
        }
    }
    else if (before_after == 2)
    { /* after given */
        if (ba->after)
        {
            yyerror("only one AFTER phrase can be given");
        }
        else
        {
            ba->after = var;
        }
    }
    return ba;
}

struct converting_struct *
alloc_converting_struct(struct sym *fromvar, struct sym *tovar,
        struct inspect_before_after *ba)
{
    struct converting_struct *new;
    new = malloc(sizeof (struct converting_struct));
    new->fromvar = fromvar;
    new->tovar = tovar;
    new->before_after = ba;
    return new;
}

struct tallying_list *
alloc_tallying_list(struct tallying_list *tl, struct sym *count,
        struct tallying_for_list *tfl)
{
    struct tallying_list *new;
    new = malloc(sizeof (struct tallying_list));
    new->next = tl;
    new->tflist = tfl;
    new->count = count;
    return new;
}

struct tallying_for_list *
alloc_tallying_for_list(struct tallying_for_list *tfl, int options,
        struct sym *forvar, struct inspect_before_after *ba)
{
    struct tallying_for_list *new;
    new = malloc(sizeof (struct tallying_for_list));
    new->next = tfl;
    new->options = options;
    new->forvar = forvar;
    new->before_after = ba;
    return new;
}

struct replacing_list *
alloc_replacing_list(struct replacing_list *rl, int options,
        struct replacing_by_list *rbl, struct sym *byvar,
        struct inspect_before_after *ba)
{

    struct replacing_list *new;
    new = malloc(sizeof (struct replacing_list));
    new->next = rl;
    new->options = options;
    new->replbylist = rbl;
    new->byvar = byvar;
    new->before_after = ba;
    return new;
}

struct replacing_by_list *
alloc_replacing_by_list(struct replacing_by_list *rbl,
        struct sym *replvar, struct sym *byvar,
        struct inspect_before_after *ba)
{
    struct replacing_by_list *new;
    new = malloc(sizeof (struct replacing_by_list));
    new->next = rbl;
    new->replvar = replvar;
    new->byvar = byvar;
    new->before_after = ba;
    return new;
}

struct unstring_delimited *
alloc_unstring_delimited(short int all, struct sym *var)
{
    struct unstring_delimited *ud;
    ud = malloc(sizeof (struct unstring_delimited));
    ud->next = NULL;
    ud->var = var;
    ud->all = all;
    return ud;
}

struct unstring_destinations *
alloc_unstring_dest(struct sym *var, struct sym *delim, struct sym *count)
{
    struct unstring_destinations *ud;
    ud = malloc(sizeof (struct unstring_destinations));
    ud->next = NULL;
    ud->var = var;
    ud->delim = delim;
    ud->count = count;
    return ud;
}

struct string_from *
alloc_string_from(struct sym *var, struct sym *delim)
{
    struct string_from *sf;
    sf = malloc(sizeof (struct string_from));
    sf->next = NULL;
    sf->var = var;
    sf->delim = delim;
    return sf;
}

void
gen_unstring(struct sym *var, struct unstring_delimited *delim,
        struct unstring_destinations *dest, struct sym *ptr,
        struct sym *tally)
{

    struct unstring_destinations *dest1;
    struct unstring_delimited *delim1;

    fprintf(o_src, "# UNSTRING %s\n", var->name);
    gen_loadvar((struct sym *) NULL); /* mark the end of destinations */
    while (dest)
    {
        gen_loadvar(dest->count);
        gen_loadvar(dest->delim);
        gen_loadvar(dest->var);
        dest1 = dest;
        dest = dest->next;
        free(dest1);
    }
    gen_loadvar((struct sym *) NULL); /* mark the end of delimiters */
    while (delim)
    {
        push_immed(delim->all); /* push "all" flag */
        gen_loadvar(delim->var);
        delim1 = delim;
        delim = delim->next;
        free(delim1);
    }
    gen_loadvar(tally);
    gen_loadvar(ptr);
    gen_loadvar(var);
    asm_call("tcob_unstring");
}

void
gen_stringcmd(struct string_from *sf, struct sym *sy, struct sym *ptr)
{
    struct string_from *sf1;
    fprintf(o_src, "# STRING into %s\n", sy->name);
    gen_loadvar((struct sym *) NULL); /* mark the end of variables */
    /* DELIMITED BY SIZE implied at end of source list */
    if (sf && (sf->delim == (struct sym *) - 1))
        sf->delim = (struct sym *) NULL;
    /* Load the string_from source list */
    while (sf)
    {
        gen_loadvar(sf->delim);
        gen_loadvar(sf->var);
        sf1 = sf;
        sf = sf->next;
        /* Delimiter of -1 means use previous delimiter */
        if (sf && (sf->delim == (struct sym *) - 1))
            sf->delim = sf1->delim;
        free(sf1);
    }
    gen_loadvar(ptr);
    gen_loadvar(sy);
    asm_call("tcob_stringcmd");
}

/* walter acrescentei cor */
static
void
gen_display_screen_item(struct sym *sy, int main, int color)
{
    struct sym *tmp, *var = sy;
    struct list *tmpl;

    if (var->litflag == 2 || var->litflag == 4)
    {
        var = ((struct vref *) var)->sym;
        if (var->litflag == 2)
            var = ((struct vref *) var)->sym;
    }
    if ((!(var->defined)) && (var->litflag != 1))
    {
        yyerror("variable %s not defined", var->name);
    }
    if (main)
    {
        fprintf(o_src, "#                      Screen Section: %s\n", var->name);
    }
    if (var->son == NULL)
    {
        fprintf(o_src, "#                      Screen Field: %s\n", var->name);
        gen_call_scr_process(var);
    }
    else
    {
        for (tmp = var->son; tmp != NULL; tmp = tmp->brother)
        {
            gen_display_screen_item(tmp, 0, color);
        }
    }
    if (main)
    {
        asm_call("tcob_display_screen");
        if (disp_list->next)
        {
            yyerror("we do not handle more than one screen");
        }
        tmpl = disp_list;
        disp_list = disp_list->next;
        free(tmpl);
    }
}

/* walter acrescentei cor */
void
gen_display_screen(int nl, int color)
{
    gen_display_line(1, nl, color);
}

/* walter acrescentei cor */
void
gen_display_line(int dupon, int nl, int color)
{
    struct list *tmp;
    /*int len;*/
    int dspflags;
    int first = 1;
    struct sym *sy;
    if (disp_list)
    {
        /* separate screen displays from display of regular variables */
        sy = (struct sym *) disp_list->var;
        if (disp_list && sy->litflag != 1)
        {
            if (sy->litflag != 4 && sy->litflag != 2 && sy->scr)
            {
                gen_display_screen_item(disp_list->var, 1, color);
                return;
            }
        }
        /* continue w/a regular variable display */
        if (nl & SCR_ERASE_EOL)
        {
            if (screen_io_enable == 0)
            {
                push_immed(dupon);
                asm_call("tcob_display_erase");
            }
        }
    }

    while (disp_list)
    {
        sy = disp_list->var;

        if ((!(sy->defined)) && (sy->litflag == 0))
        {
            yyerror("variable %s not defined,%d", sy->name, sy->litflag);
        }

        if (screen_io_enable == 0)
        {
            push_immed(dupon);
            gen_loadvar(sy);
            asm_call("tcob_display");
        }
        else
        {
            dspflags = nl;
            if (first)
            {
                first = 0;
            }
            else
            {
                dspflags &= ~2; /* avoid erasing from now on */
            }
            if (disp_list->next != NULL)
            {
                dspflags |= 1; /* allow newline only at the last item */
            }
            push_immed(color); /* walter */
            push_immed(dspflags);
            gen_loadvar(sy);
            asm_call("tcob_display_curses");
        }
        tmp = disp_list;
        disp_list = disp_list->next;
        free(tmp);
        tmp = NULL;
    }
    if (!(nl & SCR_NO_ADVANCING))
    {
        if (screen_io_enable == 0)
        {
            push_immed(dupon);
            asm_call("tcob_newline");
        }
    }
    stabs_line();
}

/* 
 * Call the function to set the display or accept position 
 */
void
gen_gotoxy_expr()
{
    stackframe_cnt += 16; /* eliminate the coords expressions */
    asm_call("tcob_goxy_expr");
}

void
gen_gotox_expr()
{
    stackframe_cnt += 8; /* eliminate the coord expressions */
    asm_call("tcob_gox_expr");
}

void
gen_gotoy_expr()
{
    stackframe_cnt += 8; /* eliminate the coord expressions */
    asm_call("tcob_goy_expr");
}

/* walter
 main sempre 1, o unico caso que e 0 e qdo usa recursividade
 echo 0 - stop literal (forcado) e qdo vem do parse traz valor
 acrescentei color */
void
gen_accept(struct sym *sy, int echo, int main, int color)
{
    struct sym *tmp, *var = sy;
    int not_screen_mask = SCR_ERASE_EOL | SCR_ERASE_EOS | SCR_NO_ADVANCING;

    if ((echo & not_screen_mask) != echo)
    { /* determine if the options require curses */
        screen_io_enable = 1;
        HTG_prg_uses_term = 1;
    }


    if (var->litflag == 2 || var->litflag == 4)
    {
        var = ((struct vref *) var)->sym;
        if (var->litflag == 2)
        {
            var = ((struct vref *) var)->sym;
        }
    }

    if (sy->litflag == 4)
    {
        echo |= SCR_IS_REFMOD;
    }

    if (var->scr)
    { /* screen or screen-item accept */
        if (main)
        {
            fprintf(o_src, "#                      Screen Section: %s\n",
                    var->name);
        }
        if (var->son == NULL)
        {
            fprintf(o_src, "#                      Screen Field: %s\n",
                    var->name);
            gen_call_scr_process(var);
        }
        else
        {
            for (tmp = var->son; tmp != NULL; tmp = tmp->brother)
            {
                gen_accept(tmp, echo, 0, color);
            }
        }
        if (main)
            asm_call("tcob_accept_screen");
    }
    else
    {
        push_immed(color); /* walter */
        push_immed(echo);
        /* why this? Why not the standard code generating
          function, gen_loaddesc()??? */
        /*fprintf(o_src,"\tmovl\t$c_base%d+%u, %%eax\n",
pgm_segment,var->descriptor);
        push_eax();*/
        gen_loaddesc2(sy, 1);
        /* this work better with the original symbol (sy),
                                because it will be interpreted as a refmod
                                or subscripted variable. */
        /* gen_loadloc( var ); */
        gen_loadloc(sy);
        if (screen_io_enable == 0)
            asm_call("tcob_accept_std");
        else
            asm_call("tcob_accept_curses");
    }
    stabs_line();
}

void
gen_accept_from_chron(struct sym *sy, int date_fmt, int is_yyyy)
{
    push_immed(is_yyyy);
    push_immed(date_fmt);
    gen_loadvar(sy);
    asm_call("tcob_accept_chron");
}

void
gen_accept_from_inkey(struct sym *sy)
{
    gen_loadloc(sy);
    asm_call("tcob_accept_inkey");
}

/* walter */
void
gen_accept_from_escapekey(struct sym *sy)
{
    gen_loadloc(sy);
    asm_call("tcob_accept_escapekey");
}

void
gen_accept_from_cmdline(struct sym *sy)
{

    struct sym *sy1;

    gen_loadvar(sy);
    /*
            fprintf(o_src,"\tmovl\t12(%%ebp), %%eax\n");
            push_eax();
            fprintf(o_src,"\tmovl\t8(%%ebp), %%eax\n");
            push_eax();
     */
    asm_call("tcob_accept_cmd_line");

    /*      Set RETURN-CODE with the value returned by
     *      the "accept_cmd_line" function, which is stored
     *      in register %eax
     */

    if ((sy1 = lookup(SVAR_RETURN_CODE, SYTB_VAR)) != NULL)
    {
        if (sy1->sec_no == SEC_STACK)
        {
            fprintf(o_src, "\tleal\t-%d(%%ebp), %%edx\n", sy1->location);
        }
        else
        {
            fprintf(o_src, "\tleal\tw_base%d+%d, %%edx\n",
                    pgm_segment, sy1->location);
        }
        fprintf(o_src, "\tmovl\t%%eax, (%%edx)\n");
    }
}

void
gen_accept_env_var(struct sym *sy, struct lit *v)
{

    struct sym *sy1, *sy2;

    sy1 = (struct sym *) v;

    /*         gen_loadloc( sy ); */
    /*         fprintf(o_src,"\tmovl\t$c_base+%u, %%eax\n",sy->descriptor); */
    /*         push_eax(); */

    gen_loadloc(sy1);

    gen_loadvar(sy);
    asm_call("tcob_accept_env_var");

    /*      Set RETURN-CODE with the value returned by
     *      the "accept_env_var" function, which is stored
     *      in register %eax
     */

    if ((sy2 = lookup(SVAR_RETURN_CODE, SYTB_VAR)) != NULL)
    {
        if (sy2->sec_no == SEC_STACK)
        {
            fprintf(o_src, "\tleal\t-%d(%%ebp), %%edx\n", sy2->location);
        }
        else
        {
            fprintf(o_src, "\tleal\tw_base%d+%d, %%edx\n",
                    pgm_segment, sy2->location);
        }
        fprintf(o_src, "\tmovl\t%%eax, (%%edx)\n");
    }

    /*  void save_literal( struct lit *v, int type ) */
    /*  currency_symbol = $<lval>4->name[0]; */
    /*  char *name; */ /* name (value) of literal */
    /*  gen_loadloc( sy ); */
    /*  gen_loaddesc( sy ); */

}

/******** structure allocation for perform info(s) ***********/

struct perf_info *
create_perf_info(struct sym *sy1, struct sym *sy2, unsigned long lj, unsigned long le)
{
    struct perf_info *rf;
    rf = malloc(sizeof (struct perf_info));
    rf->pname1 = sy1;
    rf->pname2 = sy2;
    rf->ljmp = lj;
    rf->lend = le;
    return rf;
}

struct perform_info *
create_perform_info(void)
{
    struct perform_info *rf;
    rf = malloc(sizeof (struct perform_info));
    rf->pf[0] = NULL;
    rf->pf[1] = NULL;
    rf->pf[2] = NULL;
    rf->pf[3] = NULL;
    rf->pf[4] = NULL;
    rf->pf[5] = NULL;
    return rf;
}

char *
check_perform_variables(struct sym *sy1, struct perform_info *pi1)
{

    int i, j, k;

    j = 0;
    for (i = 0; i < 6; i++)
    {
        if (pi1->pf[i] != NULL)
        {
            j++;
#if 0
#ifdef DEBUG_COMPILER
            fprintf(stderr,
                    "debug trace: check_perform_variables: var(%d:%d) '%s'\n",
                    i, j, pi1->pf[i]->pname2->name);
#endif
#endif
        }
    }

    for (i = 0; i < j; i++)
    {
#if 0
#ifdef DEBUG_COMPILER
        fprintf(stderr,
                "debug trace: check_perform_variables: var1='%s' var2(%d)='%s'\n",
                sy1->name,
                i, pi1->pf[i]->pname2->name);
#endif
#endif
        if (strcmp(sy1->name, pi1->pf[i]->pname2->name) == 0)
        {
            return sy1->name;
        }
    }

    for (i = 0; i < j; i++)
    {
        for (k = i + 1; k < j; k++)
        {

#if 0
#ifdef DEBUG_COMPILER
            fprintf(stderr,
                    "debug trace: check_perform_variables: var1(%d)='%s' var2(%d)='%s'\n",
                    i, pi1->pf[i]->pname2->name,
                    k, pi1->pf[k]->pname2->name);
#endif
#endif
            if (strcmp(pi1->pf[i]->pname2->name, pi1->pf[k]->pname2->name) == 0)
            {
                return pi1->pf[i]->pname2->name;
            }
        }
    }

    return NULL;
}

/******** structure allocation for math verbs variables ***********/

struct expr *
create_expr(char op, struct expr *left, struct expr *right)
{
    struct expr *e = malloc(sizeof (struct expr));
    struct list *list = (struct list *) malloc(sizeof (struct list));
    e->litflag = 5;
#ifdef DEBUG_COMPILER
    fprintf(o_src, "#create_expr: [0x%x] %c ", (int) e, op);
    if (left->litflag < 2)
    {
        fprintf(o_src, "%s ", ((struct sym *) left)->name);
    }
    else
    {
        fprintf(o_src, "0x%x ", (int) left);
    }
    if (right->litflag < 2)
    {
        fprintf(o_src, "%s\n", ((struct sym *) right)->name);
    }
    else
    {
        fprintf(o_src, "0x%x\n", (int) right);
    }
#endif
    e->op = op;
    e->left = left;
    e->right = right;
    expr_list = list;
    list->next = NULL;
    list->var = e;
    return e;
}

void
free_expr(struct expr *e)
{
    if ((e != NULL) && (e->litflag == 5))
    {
#ifdef DEBUG_COMPILER
        fprintf(o_src, "#free_expr: %c (%d,%d) ", e->op,
                e->left->litflag, e->right->litflag);
        if (e->left->litflag < 2)
        {
            fprintf(o_src, "%s ", ((struct sym *) e->left)->name);
        }
        else
        {
            fprintf(o_src, "0x%x ", (int) e->left);
        }
        if (e->right->litflag < 2)
        {
            fprintf(o_src, "%s\n", ((struct sym *) e->right)->name);
        }
        else
        {
            fprintf(o_src, "0x%x\n", (int) e->right);
        }
#endif
        free_expr(e->right);
        free_expr(e->left);
        free(e);
    }
    e = NULL;
}

void
free_expr_list()
{
    struct list *list;
    struct expr *e;
    for (list = expr_list; list != NULL; list = list->next)
    {
        e = (struct expr *) list->var;
        free_expr(e);
    }
    expr_list = NULL;
}

struct math_var *
create_mathvar_info(struct math_var *mv, struct sym *sy, unsigned int opt)
{

    struct math_var *rf, *tmp1, *tmp2;

    /*        if (is_numeric_sy(sy) == 0) {
               yyerror("invalid (non numeric) variable or literal \'%s\' used in arithmetic verb", sy->name);
               return mv;
            }
     */
    rf = malloc(sizeof (struct math_var));
    rf->sname = sy;
    /*        rf->rounded = opt; */
    rf->opts = opt;
    rf->next = NULL;

#if 0
#ifdef DEBUG_COMPILER
    fprintf(stderr,
            "debug trace : create_mathvar_info 0: sy->name=%s;\n",
            sy->name);
    fprintf(stderr,
            "debug trace : create_mathvar_info 1: rf->sname->name=%s;\n",
            rf->sname->name);
#endif
#endif

    if (mv == NULL)
    {
        tmp2 = rf;
        tmp1 = rf;
    }
    else
    {
        tmp1 = mv;
        tmp2 = mv;
        while (tmp1->next != NULL)
        {
#if 0
#ifdef DEBUG_COMPILER
            fprintf(stderr,
                    "debug trace : create_mathvar_info 2: tmp1->sname->name=%s;\n",
                    tmp1->sname->name);
#endif
#endif
            tmp1 = tmp1->next;
        }
        tmp1->next = rf;
    }

#if 0
#ifdef DEBUG_COMPILER
    fprintf(stderr,
            "debug trace : create_mathvar_info 3: tmp1->sname->name=%s;\n",
            tmp1->sname->name);
#endif
#endif

#if 0
#ifdef DEBUG_COMPILER
    tmp1 = tmp2;
    while (tmp1 != NULL)
    {
        fprintf(stderr,
                "debug trace : create_mathvar_info 4: tmp1->sname->name=%s;\n",
                tmp1->sname->name);
        tmp1 = tmp1->next;
    }
#endif
#endif

    return tmp2;
}

void
delete_mathvar_info(struct math_var *mv)
{

    struct math_var *tmp1, *tmp2;

    tmp1 = mv;
    while (tmp1 != NULL)
    {
#if 0
#ifdef DEBUG_COMPILER
        fprintf(stderr,
                "debug trace : delete_mathvar_info 1: tmp1->sname->name=%s;\n",
                tmp1->sname->name);
#endif
#endif
        tmp2 = tmp1->next;
        tmp1->next = NULL;
        tmp1->sname = NULL;
        free(tmp1);
        tmp1 = tmp2;
    }
}

struct invalid_key_element *
gen_before_invalid_key()
{
    struct invalid_key_element *p = malloc(sizeof (struct invalid_key_element));
    p->lbl1 = loc_label++;
    p->lbl2 = loc_label++;
    p->lbl3 = loc_label++;
    gen_jmplabel(p->lbl1);
    gen_dstlabel(p->lbl2);
    return p;
}

struct invalid_key_element *
gen_after_invalid_key(struct invalid_key_element *p)
{
    gen_jmplabel(p->lbl3);
    return p;
}

struct invalid_keys *
gen_invalid_keys(struct invalid_key_element *p1, struct invalid_key_element *p2)
{
    struct invalid_keys *p = malloc(sizeof (struct invalid_keys));
    p->invalid_key = p1;
    p->not_invalid_key = p2;
    if (p1) gen_dstlabel(p1->lbl1);
    if (p2) gen_dstlabel(p2->lbl1);
    return p;
}

/******** functions to generate math verbs ***********/

void
gen_add(struct sym *s1, struct sym *s2, int rnd)
{
    push_immed(rnd);
    gen_loadvar(s2);
    gen_loadvar(s1);
    asm_call("tcob_add");
}

void
gen_subtract(struct sym *s1, struct sym *s2, int rnd)
{
    push_immed(rnd);
    gen_loadvar(s2);
    gen_loadvar(s1);
    asm_call("tcob_subtract");
}

void
gen_multiply(struct sym *s1, struct sym *s2, struct sym *s3, int rnd)
{
    push_immed(rnd);
    gen_loadvar(s3);
    gen_loadvar(s2);
    gen_loadvar(s1);
    asm_call("tcob_multiply");
}

void
gen_compute1(struct math_var *vl1, struct sym *sy1)
{
    push_expr(sy1);
    while (vl1->next != NULL)
    {
        assign_expr(vl1->sname, vl1->opts, '0');
        vl1 = vl1->next;
    }
    assign_expr(vl1->sname, vl1->opts, '1');

}

void
gen_compute2(struct math_var *vl1, struct sym *sy1, struct math_ose *v1)
{
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;
    opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;

    gen_dstlabel(v1->lbl4); /* generate bypass jump label */
    push_expr(sy1);
    while (vl1->next != NULL)
    {
        assign_expr(vl1->sname, opts, '0');
        math_on_size_error3(v1);
        vl1 = vl1->next;
    }
    assign_expr(vl1->sname, opts, '1');
    math_on_size_error3(v1);
    math_on_size_error5(v1);
}

void
gen_add1(struct math_var *vl0, struct math_var *vl2, struct math_ose *v1)
{
    struct math_var *vl1;
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4);
    }
    while (vl2 != NULL)
    {
        push_expr(vl2->sname);
        vl1 = vl0;
        while (vl1 != NULL)
        {
            push_expr(vl1->sname);
            add_expr();
            vl1 = vl1->next;
        }
        if (v1 != NULL)
        {
            opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl2->opts;
        }
        assign_expr(vl2->sname, opts, '1');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl2 = vl2->next;
    }
    math_on_size_error5(v1);

}

void
gen_add2(struct math_var *vl1, struct math_var *vl2, struct sym *sy1, struct math_ose *v1)
{
    int i = 0;
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4); /* generate bypass jump label */
    }
    if (sy1 != NULL)
    {
        push_expr(sy1);
        while (vl1 != NULL)
        {
            push_expr(vl1->sname);
            add_expr();
            vl1 = vl1->next;
        }
    }
    else
    {
        push_expr(vl1->sname);
        vl1 = vl1->next;
        i = 1;
        while (vl1 != NULL)
        {
            push_expr(vl1->sname);
            add_expr();
            vl1 = vl1->next;
            i++;
        }
        if (i < 2)
        {
            yyerror("At least 2 variables and/or numeric literals required in ADD statement");
        }
    }
    while (vl2->next != NULL)
    {
        if (v1 != NULL)
        {
            opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl2->opts;
        }
        assign_expr(vl2->sname, opts, '0');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl2 = vl2->next;
    }
    if (v1 != NULL)
    {
        opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
    }
    else
    {
        opts = vl2->opts;
    }
    assign_expr(vl2->sname, opts, '1');
    /* ON SIZE ERROR option only */
    math_on_size_error3(v1);
    math_on_size_error5(v1);
}

void
gen_add3(struct math_var *vl0, struct math_var *vl2, struct math_ose *v1)
{
    struct math_var *vl1;
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    while (vl2 != NULL)
    {
        push_expr(vl2->sname);
        vl1 = vl0;
        while (vl1 != NULL)
        {
            push_expr(vl1->sname);
            add_expr();
            vl1 = vl1->next;
        }
        if (v1 != NULL)
        {
            opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl2->opts;
        }
        assign_expr(vl2->sname, opts, '1');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl2 = vl2->next;
    }

}

void
gen_subtract1(struct math_var *vl0, struct math_var *vl2, struct math_ose *v1)
{
    struct math_var *vl1;
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4);
    }
    while (vl2 != NULL)
    {
        push_expr(vl2->sname);
        vl1 = vl0;
        while (vl1 != NULL)
        {
            push_expr(vl1->sname);
            subtract_expr();
            vl1 = vl1->next;
        }
        if (v1 != NULL)
        {
            opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl2->opts;
        }
        assign_expr(vl2->sname, opts, '1');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl2 = vl2->next;
    }
    math_on_size_error5(v1);
}

void
gen_subtract2(struct math_var *vl1, struct math_var *vl2, struct sym *sy1, struct math_ose *v1)
{
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4);
    }
    push_expr(sy1);
    while (vl1 != NULL)
    {
        push_expr(vl1->sname);
        subtract_expr();
        vl1 = vl1->next;
    }
    while (vl2->next != NULL)
    {
        if (v1 != NULL)
        {
            opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl2->opts;
        }
        assign_expr(vl2->sname, opts, '0');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl2 = vl2->next;
    }
    if (v1 != NULL)
    {
        opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
    }
    else
    {
        opts = vl2->opts;
    }
    assign_expr(vl2->sname, opts, '1');
    /* ON SIZE ERROR option only */
    math_on_size_error3(v1);
    math_on_size_error5(v1);
}

void
gen_subtract3(struct math_var *vl0, struct math_var *vl2, struct math_ose *v1)
{
    struct math_var *vl1;
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    while (vl2 != NULL)
    {
        push_expr(vl2->sname);
        vl1 = vl0;
        while (vl1 != NULL)
        {
            push_expr(vl1->sname);
            subtract_expr();
            vl1 = vl1->next;
        }
        if (v1 != NULL)
        {
            opts = vl2->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl2->opts;
        }
        assign_expr(vl2->sname, opts, '1');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl2 = vl2->next;
    }
}

void
gen_multiply1(struct math_var *vl1, struct sym *sy1, struct math_ose *v1)
{
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump */
        gen_dstlabel(v1->lbl4);
    }
    while (vl1->next != NULL)
    {
        push_expr(sy1);
        push_expr(vl1->sname);
        multiply_expr();
        if (v1 != NULL)
        {
            opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl1->opts;
        }
        assign_expr(vl1->sname, opts, '1');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl1 = vl1->next;
    }
    push_expr(sy1);
    push_expr(vl1->sname);
    multiply_expr();
    if (v1 != NULL)
    {
        opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;
    }
    else
    {
        opts = vl1->opts;
    }
    assign_expr(vl1->sname, opts, '1');
    /* ON SIZE ERROR option only */
    math_on_size_error3(v1);
    math_on_size_error5(v1);
}

void
gen_multiply2(struct math_var *vl1, struct sym *sy1, struct sym *sy2, struct math_ose *v1)
{
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4);
    }
    push_expr(sy1);
    push_expr(sy2);
    multiply_expr();
    while (vl1->next != NULL)
    {
        if (v1 != NULL)
        {
            opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl1->opts;
        }
        assign_expr(vl1->sname, opts, '0');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl1 = vl1->next;
    }
    if (v1 != NULL)
    {
        opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;
    }
    else
    {
        opts = vl1->opts;
    }
    assign_expr(vl1->sname, opts, '1');
    /* ON SIZE ERROR option only */
    math_on_size_error3(v1);
    math_on_size_error5(v1);
}

void
gen_divide1(struct math_var *vl1, struct sym *sy1, struct math_ose *v1)
{
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump */
        gen_dstlabel(v1->lbl4);
    }
    while (vl1 != NULL)
    {
        push_expr(vl1->sname);
        push_expr(sy1);
        divide_expr();
        if (v1 != NULL)
        {
            opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl1->opts;
        }
        assign_expr(vl1->sname, opts, '1');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl1 = vl1->next;
    }
    math_on_size_error5(v1);
}

void
gen_divide2(struct math_var *vl1, struct sym *sy1, struct sym *sy2, struct math_ose *v1)
{
    /* option flags: 1=rounded, 2=on_size_error */
    int opts;

    /* ON SIZE ERROR option only */
    if (v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4);
    }
    push_expr(sy1);
    push_expr(sy2);
    divide_expr();
    while (vl1->next != NULL)
    {
        if (v1 != NULL)
        {
            opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;
        }
        else
        {
            opts = vl1->opts;
        }
        assign_expr(vl1->sname, opts, '0');
        /* ON SIZE ERROR option only */
        math_on_size_error3(v1);
        vl1 = vl1->next;
    }
    if (v1 != NULL)
    {
        opts = vl1->opts | MATH_OPT_ON_SIZE_ERROR;
    }
    else
    {
        opts = vl1->opts;
    }
    assign_expr(vl1->sname, opts, '1');
    /* ON SIZE ERROR option only */
    math_on_size_error3(v1);
    math_on_size_error5(v1);
}

void
gen_divide4(struct sym *s1, struct sym *s2, struct sym *s3, struct sym *s4, int rnd, struct math_ose *v1)
{

    /* [NOT]ON SIZE ERROR option */
    if (v1 != NULL)
    {
        /* generate bypass jump */
        gen_dstlabel(v1->lbl4);
    }
    push_immed(rnd);
    gen_loadvar(s4);
    gen_loadvar(s3);
    gen_loadvar(s2);
    gen_loadvar(s1);
    asm_call("tcob_divide1");
    math_on_size_error3(v1);
    math_on_size_error5(v1);
}

/******** functions for subscripted var manipulation ***********/
struct vref *
create_subscripted_var(struct sym * sy, struct vref *subs)
{
    struct vref *ref;
    ref = malloc(sizeof (struct vref));
    ref->litflag = 2;
    ref->sym = sy;
    ref->next = subs;
    return ref;
}

struct vref *
create_subscript(struct sym *sy)
{
    struct vref *ref;
    ref = malloc(sizeof (struct vref));
    ref->litflag = ','; /* the end of subscript is here */
    ref->sym = sy; /* this is the actual variable */
    ref->next = NULL;
    return ref;
}

struct vref *
add_subscript_item(struct vref *subs, char op, struct sym *item)
{
    struct vref *ref, *tmp;
    ref = malloc(sizeof (struct vref));
    tmp = subs;
    while (tmp->next) tmp = tmp->next;
    tmp->next = ref;
    ref->litflag = ',';
    ref->sym = item;
    ref->next = NULL;
    tmp->litflag = op;
    return subs;
}

struct vref *
add_subscript(struct vref *ref, struct vref *subs)
{
    struct vref *tmp;
    tmp = subs;
    while (tmp->next) tmp = tmp->next;
    tmp->next = ref;
    return subs;
}

int
check_subscripts(struct sym *subs)
{
    struct vref *ref;
    struct sym *sy;
    sy = ((struct vref *) subs)->sym;
    for (ref = (struct vref *) subs; ref; ref = ref->next)
    {

#ifdef DEBUG_COMPILER
        fprintf(o_src, "#check_subscripts: symbol: %s, op: '%c'\n",
                ((struct sym *) ref->sym)->name,
                ref->litflag == 2 ? 2 : ref->litflag);
#endif

        if (ref->litflag == ',')
        {
            while (sy && !sy->occurs_flg)
            {
#ifdef DEBUG_COMPILER
                fprintf(o_src, "#check_subscripts: symbol: %s\n",
                        sy->name);
#endif
                sy = sy->parent;
            }
            if (!sy)
            {
                hterror(102, 4, "check_subscripts: no parent found");
                return 0; /* excess subscripts, error */
            }
            sy = sy->parent;
        }
    }
    while (sy && !sy->occurs_flg) /* any other subscripts needed ? */
        sy = sy->parent;
    return (sy == NULL) ? 1 : 0;
}

void
create_occurs_info(int min, int max, struct sym *depend)
{
    curr_field->occurs = (struct occurs *) malloc(sizeof (struct occurs));
    curr_field->occurs->min = min;
    curr_field->occurs->max = max;
    curr_field->occurs->depend = depend;
    curr_field->times = max;
    curr_field->occurs_flg++;
}

/******** functions for refmoded var manipulation ***********/
struct refmod *
create_refmoded_var(struct sym * sy, struct sym *syoff, struct sym *sylen)
{
    struct refmod *ref;
    ref = malloc(sizeof (struct refmod));
    ref->litflag = 4;
    ref->sym = sy;
    ref->off = syoff;
    ref->len = sylen;
    ref->slot = refmod_slots++;
    return ref;
}

int
check_refmods(struct sym *var)
{
    struct refmod *ref = (struct refmod *) var;
    struct sym *sy = ref->sym;

    if (sy->litflag == 2) sy = ((struct vref *) sy)->sym;

    return (sy == NULL) ? 1 : 0;
}

struct sym *
get_variable_item(struct sym *sy)
{
    struct sym *son, *item;
    if (sy->litflag != 0)
        return NULL;
    if (sy->occurs != NULL)
        return sy;
    for (son = sy->son; son != NULL; son = son->brother)
    {
        if ((item = get_variable_item(son)))
            return item;
    }
    return NULL;
}

void
adjust_desc_length(struct sym *sy)
{
    int stack_save = stackframe_cnt;
    struct sym *item;
    stackframe_cnt = 0;
    item = get_variable_item(sy);
    /* push_immed(0); */
    gen_temp_storage(sizeof (struct fld_desc));
    gen_loaddesc1(item, 0);
    gen_loaddesc1(sy, 0);
    push_immed(item->occurs->max);
    push_immed(item->occurs->min);
    gen_loadvar(item->occurs->depend);
    asm_call("tcob_adjust_length");
    stackframe_cnt = stack_save;
    need_desc_length_cleanup = 1;
}

void
gen_loadloc(struct sym *sy_p)
{
    loadloc_to_eax(sy_p);
    push_eax();
}

void
gen_loaddesc(struct sym *sy)
{
    gen_loaddesc1(sy, 1);
}

void
gen_loadvar(struct sym *sy)
{
    struct sym *var;
    if (sy == NULL)
    {
        push_immed(0);
    }
    else
    {
        var = sy;
        if (var->litflag == 2 || var->litflag == 4)
        {
            var = ((struct vref *) var)->sym;
            if (var->litflag == 2)
                var = ((struct vref *) var)->sym;
        }
        if (!HTG_libcob)
            gen_loadloc(sy);
        gen_loaddesc(sy);
    }
}

int
is_numeric_sy(struct sym *sy)
{
    char type;
    if (sy->litflag == 2)
    { /* subscripted ? */
        sy = ((struct vref *) sy)->sym;
    }
    type = sy->type;
    if ((type == DTYPE_DISPLAY) || (type == DTYPE_BININT)
            || (type == DTYPE_PACKED) || (type == DTYPE_FLOAT))
        return 1;
    return 0;
}

int
is_numeric_dest_sy(struct sym *sy)
{
    char type;
    if (sy->litflag == 2)
    { /* subscripted ? */
        sy = ((struct vref *) sy)->sym;
    }
    type = sy->type;
    if ((type == DTYPE_DISPLAY)
            || (type == DTYPE_BININT)
            || (type == DTYPE_PACKED)
            || (type == DTYPE_FLOAT)
            || (type == DTYPE_EDITED))
        return 1;
    return 0;
}

void
gen_class_check(struct sym *sy, int class)
{
    int invert = 0;
    class &= ~(COND_UNARY | COND_CLASS);
    if (class & 4)
    { /* was it inverted (NOT) ? */
        class ^= 7;
        invert++;
    }
    if (class == CLASS_NUMERIC)
    {
        /*if (!sy || is_numeric_sy(sy)) {
         */
        if (sy) /* don't save already pushed variable */
            gen_loadvar(sy);
        else
            stackframe_cnt += 8;
        asm_call("tcob_check_numeric");
        fprintf(o_src, "\tand\t%%eax,%%eax\n");
        /*}
        else {
                yyerror("invalid NUMERIC class check");
        }*/
    }
    else
    {
        /* from now on, only alphabetic tests are allowed */
        /*if (is_numeric_sy(sy)) {
                yyerror("invalid ALPHABETIC class check");
        }*/
        gen_loadvar(sy);
        switch (class)
        {
            case CLASS_ALPHABETIC:
                asm_call("tcob_check_alphabetic");
                break;
            case CLASS_ALPHABETIC_UPPER:
                asm_call("tcob_check_upper");
                break;
            case CLASS_ALPHABETIC_LOWER:
                asm_call("tcob_check_lower");
                break;
            default:
                yyerror("unknown class condition");
                break;
        }
        fprintf(o_src, "\tand\t%%eax,%%eax\n");
    }
    if (invert)
        gen_not();
}

void
gen_inspect(struct sym *var, void *list, int operation)
{
    /*struct inspect_before_after *ba,*ba1;*/
    struct tallying_list *tl, *tl1;
    struct tallying_for_list *tfl, *tfl1;
    struct replacing_list *rl, *rl1;
    struct replacing_by_list *rbl, *rbl1;
    struct converting_struct *cv;

    if (!operation)
    {
        if (!list) return;
        fprintf(o_src, "# INSPECT TALLYING %s\n", var->name);
        gen_loadvar((struct sym *) NULL);
        tl = (struct tallying_list *) list;
        while (tl)
        {
            tfl = tl->tflist;
            push_immed(0);
            while (tfl)
            {
                gen_loadvar(tfl->before_after->after);
                gen_loadvar(tfl->before_after->before);
                if (tfl->options != INSPECT_CHARACTERS)
                {
                    gen_loadvar(tfl->forvar);
                }
                push_immed(tfl->options);
                free(tfl->before_after);
                tfl1 = tfl;
                tfl = tfl->next;
                free(tfl1);
            }
            gen_loadvar(tl->count);
            tl1 = tl;
            tl = tl->next;
            free(tl1);
            tl1 = NULL;
        }
        gen_loadvar(var);
        asm_call("tcob_inspect_tallying");
    }
    else if (operation == 1)
    {
        if (!list) return;
        fprintf(o_src, "# INSPECT REPLACING %s\n", var->name);
        rl = (struct replacing_list *) list;
        push_immed(0);
        while (rl)
        {
            if (rl->options == INSPECT_CHARACTERS)
            {
                gen_loadvar(rl->before_after->after);
                gen_loadvar(rl->before_after->before);
                gen_loadvar(rl->byvar);
                push_immed(rl->options);
            }
            else
            {
                rbl = rl->replbylist;
                while (rbl)
                {
                    gen_loadvar(rbl->before_after->after);
                    gen_loadvar(rbl->before_after->before);
                    gen_loadvar(rbl->byvar);
                    gen_loadvar(rbl->replvar);
                    free(rbl->before_after);
                    rbl1 = rbl;
                    rbl = rbl->next;
                    free(rbl1);
                    push_immed(rl->options);
                }
            }
            rl1 = rl;
            rl = rl->next;
            free(rl1);
            rl1 = NULL;
        }
        gen_loadvar(var);
        asm_call("tcob_inspect_replacing");
    }
    else
    {
        fprintf(o_src, "# INSPECT CONVERTING %s\n", var->name);
        cv = (struct converting_struct *) list;
        gen_loadvar(cv->before_after->after);
        gen_loadvar(cv->before_after->before);
        gen_loadvar(cv->tovar);
        gen_loadvar(cv->fromvar);
        gen_loadvar(var);
        asm_call("tcob_inspect_converting");
    }
}

void
gen_tcob_proto1(struct sym *sy)
{
    gen_loadvar(sy);
    asm_call("tcob_proto1");
}

void
gen_tcob_proto2(struct sym *sy1, struct sym *sy2)
{
    gen_loadvar(sy2);
    gen_loadvar(sy1);
    asm_call("tcob_proto2");
}

void
gen_moves(struct sym *sy_src, struct gvar_list *gsylst)
{
    struct gvar_list *sy_dst;

    for (sy_dst = gsylst; sy_dst->next != NULL; sy_dst = sy_dst->next)
    {
        gen_move(sy_src, sy_dst->u.sym);
    }
    gen_move(sy_src, sy_dst->u.sym);
}

void
gen_move(struct sym *sy_src, struct sym *sy_dst)
{
    long tmplabel = 0;
    struct sym *var;

#ifdef DEBUG_COMPILER
    {
        struct sym *esys = sy_src, *esyd = sy_dst;
        if (esys->litflag == 4)
            esys = ((struct refmod *) esys)->sym;
        if (esyd->litflag == 4)
            esyd = ((struct refmod *) esyd)->sym;
        fprintf(o_src, "# MOVE %s --> ", sch_convert(esys->name));
        fprintf(o_src, "        %s\n", sch_convert(esyd->name));
    }
#endif
    /*        Make sure BLANK test is done on a sym struct, and not a vref struct */
    var = sy_dst;
    if (var->litflag == 2 || var->litflag == 4)
    {
        var = ((struct vref *) var)->sym;
        if (var->litflag == 2)
            var = ((struct vref *) var)->sym;
    }
    /*        A blank when zero field is treated here instead of the RTS */
    if (var->flags.blank)
    {
        tmplabel = loc_label++;
        gen_compare(sy_src, EQUAL, (struct sym *) spe_lit_ZE);
        fprintf(o_src, "\tjnz\t.L%ld\n", tmplabel);
        gen_loadvar(sy_dst);
        gen_loadvar((struct sym *) spe_lit_SP);
        asm_call("tcob_move_x_x");
        gen_jmplabel(tmplabel + 1);
        fprintf(o_src, ".L%ld:\n", tmplabel);
    }
    /* default move */
    gen_loadvar(sy_dst);
    gen_loadvar(sy_src);
    /* an initial value of a literal X field into an numeric edited field
       should move straight instead of going thru an edition */
    /*        if (sy_src->type == DTYPE_ALPHANUMERIC && sy_dst->type == DTYPE_EDITED) {
                    asm_call("tcob_move_x_x");
                    }
            else { */
    RTL_CALL("move");
    /*                } */
#ifdef TODO
    if (sy_src->type == DTYPE_ALPHANUMERIC && sy_dst->type == DTYPE_EDITED)
    {
        asm_call("tcob_move_x_x");
    }
    else
    {
        asm_call("tcob_move");
    }
#endif
    if (tmplabel)
    {
        tmplabel = loc_label++;
        fprintf(o_src, ".L%ld:\n", tmplabel);
    }
}

void
gen_movelength(struct sym *sy1, struct sym *sy2)
{
    if (sy1->litflag == 1)
    {
        push_immed(((struct lit *) sy1)->len);
    }
    else
    {
        push_immed(sy1->len);
    }
    gen_loadvar(sy2);
    asm_call("tcob_assign_int");
}

void
gen_move_init(struct sym *sy_src, struct sym *sy_dst)
{
#ifdef DEBUG_COMPILER
    {
        struct sym *esys = sy_src, *esyd = sy_dst;
        fprintf(o_src, "# MOVE_INIT %s --> ", sch_convert(esys->name));
        fprintf(o_src, "        %s\n", sch_convert(esyd->name));
    }
#endif
    /* default move */
    gen_loadvar(sy_dst);
    gen_loadvar(sy_src);
    /* an initial value of a literal X field into an numeric edited field
       should move straight instead of going thru an edition */
    if (sy_src->type == DTYPE_ALPHANUMERIC && sy_dst->type == DTYPE_EDITED)
    {
        asm_call("tcob_move_x_x");
    }
    else
    {
        RTL_CALL("move");
    }
}

void
gen_movecorr(struct sym *sy1, struct sym *sy2)
{
    struct sym *t1, *t2;
    if (sy1->litflag || sy2->litflag)
    {
        yyerror("sorry we don't handle this case yet!");
        return;
    }
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# MOVE CORR %s --> %s\n", sy1->name, sy2->name);
#endif
    t1 = sy1->son;
    /* repeat for all sons of sy1 */
    while (t1 != NULL)
    {
        if (!t1->redefines && t1->times == 1)
        {
            t2 = sy2->son;
            /* repeat for all sons of sy2 */
            while (t2 != NULL)
            {
                if (!t2->redefines && t2->times == 1)
                {
                    if (strcmp(t1->name, t2->name) == 0)
                    {
                        if ((t1->type != DTYPE_GROUP)
                                || (t2->type != DTYPE_GROUP))
                        {
                            gen_move(t1, t2);
                        }
                        else
                        {
                            gen_movecorr(t1, t2);
                        }
                    }
                }
                t2 = t2->brother;
            }
        }
        t1 = t1->brother;
    }
}

struct sym *
define_label(struct sym *lab, int lab_type,
        struct sym *parent, int parent_type)
{

    struct sym *tlab = lab;
    struct lit *tlit;
    struct sym *tparent;

    if (parent == NULL)
    {
        tparent = curr_section;
    }
    else
    {
        tparent = parent;
    }
    if (lab_type == 1)
    {
        tlit = (struct lit *) lab;
        tlab = install(tlit->name, SYTB_LAB, 0);
    }
    else
    {
        tlab = lab;
    }

    if (tlab->defined == 0)
    {
        tlab->defined = 2;
        tlab->parent = tparent;
    }
    else
    {
        if (parent_type == 1)
        {
            tlit = (struct lit *) parent;
            tlab = install(tlit->name, SYTB_LAB, 0);
        }
        if ((tlab = lookup_label(tlab, tparent)) == NULL)
        {
            tlab = install(tlab->name, SYTB_LAB, 2);
            tlab->defined = 2;
            tlab->parent = tparent;
        }
    }
    return tlab;
}

void
gen_addcorr(struct sym *sy1, struct sym *sy2, int rnd)
{
    struct sym *t1, *t2;
    if (sy1->litflag || sy2->litflag)
    {
        yyerror("sorry we don't handle this case yet!");
    }
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# ADD CORR %s --> %s\n", sy1->name, sy2->name);
#endif
    t1 = sy1->son;
    /* repeat for all sons of sy1 */
    while (t1 != NULL)
    {
        if (!t1->redefines && t1->times == 1)
        {
            t2 = sy2->son;
            /* repeat for all sons of sy2 */
            while (t2 != NULL)
            {
                if (!t2->redefines && t2->times == 1)
                {
                    if (strcmp(t1->name, t2->name) == 0)
                    {
                        if ((t1->type != DTYPE_GROUP)
                                && (t2->type != DTYPE_GROUP))
                        {
                            gen_add(t1, t2, rnd);
                        }
                        else
                        {
                            gen_addcorr(t1, t2, rnd);
                        }
                    }
                }
                t2 = t2->brother;
            }
        }
        t1 = t1->brother;
    }
}

void
gen_addcorr1(struct math_var *mv1, struct math_var *mv2, int rnd, struct math_ose
        *v1)
{
    struct sym *sy1, *sy2;
    struct sym *t1, *t2;
    struct math_var *tmv1, *tmv2;
    static int addcorr_level = 0;

    if (mv1->sname->litflag || mv2->sname->litflag)
    {
        yyerror("sorry we don't handle this case yet!");
    }
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# ADD CORR %s --> %s, lv %d\n",
            mv1->sname->name, mv2->sname->name, addcorr_level);
#endif
    /* ON SIZE ERROR option only */
    if (addcorr_level == 0 && v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4);
    }
    addcorr_level++;
    sy1 = mv1->sname;
    sy2 = mv2->sname;
    t1 = sy1->son;
    /* repeat for all sons of sy1 */
    while (t1 != NULL)
    {
        if (!t1->redefines && t1->times == 1)
        {
            t2 = sy2->son;
            /* repeat for all sons of sy2 */
            while (t2 != NULL)
            {
                if (!t2->redefines && t2->times == 1)
                {
                    if (strcmp(t1->name, t2->name) == 0)
                    {
                        tmv1 = create_mathvar_info(NULL, t1, 0);
                        tmv2 = create_mathvar_info(NULL, t2, 0);
                        if ((t1->type != DTYPE_GROUP)
                                && (t2->type != DTYPE_GROUP))
                        {
                            gen_add3(tmv1, tmv2, v1);
                        }
                        else
                        {
                            gen_addcorr1(tmv1, tmv2, rnd, v1);
                        }
                        delete_mathvar_info(tmv1);
                        delete_mathvar_info(tmv2);
                    }
                }
                t2 = t2->brother;
            }
        }
        t1 = t1->brother;
    }
    addcorr_level--;
    if (addcorr_level == 0)
    {
        math_on_size_error5(v1);
    }

}

void
gen_subtractcorr(struct sym *sy1, struct sym *sy2, int rnd)
{
    struct sym *t1, *t2;
    if (sy1->litflag || sy2->litflag)
    {
        yyerror("sorry we don't handle this case yet!");
    }
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# SUB CORR %s --> %s\n", sy1->name, sy2->name);
#endif
    t1 = sy1->son;
    /* repeat for all sons of sy1 */
    while (t1 != NULL)
    {
        if (!t1->redefines && t1->times == 1)
        {
            t2 = sy2->son;
            /* repeat for all sons of sy2 */
            while (t2 != NULL)
            {
                if (!t2->redefines && t2->times == 1)
                {
                    if (strcmp(t1->name, t2->name) == 0)
                    {
                        if ((t1->type != DTYPE_GROUP)
                                && (t2->type != DTYPE_GROUP))
                        {
                            gen_subtract(t1, t2, rnd);
                        }
                        else
                        {
                            gen_subtractcorr(t1, t2, rnd);
                        }
                    }
                }
                t2 = t2->brother;
            }
        }
        t1 = t1->brother;
    }
}

void
gen_subtractcorr1(struct math_var *mv1, struct math_var *mv2, int rnd,
        struct math_ose *v1)
{
    struct sym *sy1, *sy2;
    struct sym *t1, *t2;
    struct math_var *tmv1, *tmv2;
    static int subcorr_level = 0;

    if (mv1->sname->litflag || mv2->sname->litflag)
    {
        yyerror("sorry we don't handle this case yet!");
    }
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# SUB CORR %s --> %s, lv %d\n",
            mv1->sname->name, mv2->sname->name, subcorr_level);
#endif
    /* ON SIZE ERROR option only */
    if (subcorr_level == 0 && v1 != NULL)
    {
        /* generate bypass jump label */
        gen_dstlabel(v1->lbl4);
    }
    subcorr_level++;
    sy1 = mv1->sname;
    sy2 = mv2->sname;
    t1 = sy1->son;
    /* repeat for all sons of sy1 */
    while (t1 != NULL)
    {
        if (!t1->redefines && t1->times == 1)
        {
            t2 = sy2->son;
            /* repeat for all sons of sy2 */
            while (t2 != NULL)
            {
                if (!t2->redefines && t2->times == 1)
                {
                    if (strcmp(t1->name, t2->name) == 0)
                    {
                        tmv1 = create_mathvar_info(NULL, t1, 0);
                        tmv2 = create_mathvar_info(NULL, t2, 0);
                        if ((t1->type != DTYPE_GROUP)
                                && (t2->type != DTYPE_GROUP))
                        {
                            gen_subtract3(tmv1, tmv2, v1);
                        }
                        else
                        {
                            gen_subtractcorr1(tmv1, tmv2, rnd, v1);
                            delete_mathvar_info(tmv1);
                            delete_mathvar_info(tmv2);
                        }
                    }
                }
                t2 = t2->brother;
            }
        }
        t1 = t1->brother;
    }
    subcorr_level--;
    if (subcorr_level == 0)
    {
        math_on_size_error5(v1);
    }
}

void
gen_set_complex(struct sym *idx, int which, struct sym * var)
{
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# set complex %s to %s\n", idx ? idx->name : "(null)",
            var ? var->name : "(null)");
#endif
    switch (which)
    {
        case SET_TO: /* just move this value */
            gen_move(idx, var);
            break;
        case SET_UP_BY: /* we need to add this value to the index */
            gen_add(idx, (struct sym *) define_num_lit(1), 0);
            break;
        case SET_DOWN_BY:
            gen_subtract(idx, (struct sym *) define_num_lit(1), 0);
            break;
        default:
            yyerror("SET option unavailable");
    }
}

void
gen_set_list(struct list *idx, int which, struct sym *var,
        int adrof_idx, int adrof_var)
{
    struct sym * svar;

    while (idx != NULL)
    {
        svar = idx->var;
        fprintf(o_src, "# SET %s \n", svar->name);
        gen_set(idx->var, which, var, adrof_idx, adrof_var);
        idx = idx->next;
    }
    vars_list = NULL;
}

/******* short-circuit conditional evaluators ********/
int
gen_evaluate_start()
{
    int i = loc_label++;
    fprintf(o_src, "# EVALUATE statement\n");
    return i;
}

int
subject_set_size(struct selsubject *ssbj)
{
    int size = 0;
    while (ssbj != NULL)
    {
        size++;
        ssbj = ssbj->next;
    }
    return size;
}

int
selection_object_size(int type)
{
    switch (type)
    {
        case SOBJ_EXPR:
        case SOBJ_NEGEXPR:
            return 8;
        case SOBJ_RANGE:
        case SOBJ_NEGRANGE:
            return 16;
        default:
            return 0;
    }
}

int
selection_subject_type(int level, struct selsubject *ssbj)
{
    while (level--)
    {
        ssbj = ssbj->next;
    }
    return ssbj->type;
}

void
gen_perform(struct sym *sy)
{
    gen_perform_thru(sy, sy);
}

void
set_usage(struct sym *sy, int usage)
{
    sy->stype = ' ';
    switch (usage)
    {
        case USAGE_COMP1:
            sy->len = 4;
            sy->decimals = 7;
            sy->type = 'U';
            sy->sign = 1;
            /* default picture is 14 digits "S9(7)V9(7)" */
            strcpy((char *) picture, "S\x01\x39\x07\x56\x01\x39\x07");
            break;
        case USAGE_COMP2:
            sy->len = 8;
            sy->decimals = 15;
            sy->type = 'U';
            sy->sign = 1;
            /* default picture is 30 digits "S9(15)V9(15)" */
            strcpy((char *) picture, "S\x01\x39\x0f\x56\x01\x39\x0f");
            break;
        case USAGE_COMP3:
            sy->type = 'C';
            break;
        case USAGE_COMP:
            sy->stype = 'B';
            /* field length computed by query_comp_length() */
            sy->len = 0;
            sy->type = 'B'; /* binary field */
            break;
        case USAGE_COMP5:
            sy->stype = '5';
            sy->len = 0;
            sy->type = 'B'; /* binary field */
            break;
        case USAGE_COMPX:
            sy->stype = 'X';
            sy->len = 0;
            sy->type = 'B'; /* binary field */
            break;
        case USAGE_POINTER: /* POINTER */
            sy->len = 4;
            sy->decimals = 0;
            sy->type = 'B'; /* pointers are binary fields */
            /* pointer default picture: "9(10)" */
            strcpy((char *) picture, "9\x0a");
            sy->flags.is_pointer = 1;
            break;
        case USAGE_BINARY_CHAR:
            sy->len = 1;
            sy->type = 'B';
            break;
        case USAGE_BINARY_SHORT:
            sy->len = 2;
            sy->type = 'B';
            break;
        case USAGE_BINARY_LONG:
            sy->len = 4;
            sy->type = 'B';
            break;
        case USAGE_BINARY_DOUBLE:
            sy->len = 8;
            sy->type = 'B';
            break;
        case USAGE_INDEX:
            sy->len = 4;
            sy->type = 'B';
            sy->decimals = 0;
            break;
    }
}

void
gen_picture(void)
{
    if (curr_field->type != DTYPE_GROUP)
    {
        curr_field->picstr = (char *) malloc(strlen((char *) picture) + 1);
        strcpy(curr_field->picstr, (char *) picture);
    }
}

int
save_pic_char(char c, int i)
{
    char c1 = (char) toupper(c);
    unsigned int n;

    switch (c1)
    {
        case 'A':
            piccnt += i;
            if (curr_field->type != DTYPE_ALPHANUMERIC
                    && curr_field->type != DTYPE_EDITED)
                curr_field->type = DTYPE_ALPHA;
            break;
        case 'X':
            piccnt += i;
            if (curr_field->type == DTYPE_DISPLAY)
                curr_field->type = DTYPE_ALPHANUMERIC;
            break;
        case 'Z':
            curr_field->type = DTYPE_EDITED;
        case '9':
            piccnt += i;
            if (v_flag) decimals += i;
            n_flag = 1;
            break;
        case 'V':
            if (v_flag)
                yyerror("invalid picture: V already given");
            v_flag = 1;
            break;
        case 'P':
            piccnt += i;
            if (!n_flag)
                v_flag = 1; /* implicit V just before the first P */
            if (v_flag)
            {
                decimals += i;
                pscale += i;
            }
            else
                pscale -= i;
            break;
        case 'S':
            sign = 1;
            break;
        case '.':
        case ',':
        case '0':
        case 'B':
        case '/':
        case '+':
        case '-':
        case '*':
        case 'C':
        case 'R':
        case 'D':
            curr_field->type = DTYPE_EDITED;
            piccnt += i;
            break;
        default:
            if (c1 == currency_symbol)
            {
                curr_field->type = DTYPE_EDITED;
                piccnt += i;
                break;
            }
            else
                return 0;
    } /* switch(c1) */

    if (picture[picix] == 0)
    { /* first char in PIC string? */
        picture[picix] = c1;
        picture[picix + 1] = 0;
    }
    if (((char) picture[picix] != c1) || (picture[picix + 1] == 255))
    {
        picix += 2;
        picture[picix] = c1;
        picture[picix + 1] = 0;
    }
    for (n = i + picture[picix + 1]; n > 255; n -= 255)
    {
        picture[picix + 1] = 255;
        picture[picix + 2] = picture[picix];
        picix += 2;
    }
    picture[picix + 1] = n;

    return 1;
}

void
define_special_fields()
{

    struct sym *sy, *tmp;
    struct lit *ly;

    sy = install(SVAR_RETURN_CODE, SYTB_VAR, 0);
    spe_lit_SP = save_special_literal(' ', 'X', "%SPACES%");
    spe_lit_LV = save_special_literal('\0', 'X', "%LOW-VALUES%");
    spe_lit_HV = save_special_literal('\xff', 'X', "%HIGH-VALUES%");
    spe_lit_ZE = save_special_literal('0', '9', "%ZEROS%");
    spe_lit_QU = save_special_literal('"', 'X', "%QUOTES%");
    spe_lit_SP->all = 1;
    spe_lit_LV->all = 1;
    spe_lit_HV->all = 1;
    spe_lit_ZE->all = 1;
    spe_lit_QU->all = 1;

    ly = spe_lit_ZE;

    /*        sy->len=5; */
    sy->len = 4;
    sy->decimals = 0;
    sy->pscale = 0;
    sy->level = 1;
    sy->defined = 1;
    sy->type = DTYPE_BININT; /* assume numeric "usage is comp" item */
    sy->redefines = NULL;
    sy->linkage_flg = at_linkage;
    sy->sec_no = SEC_RETURN_CODE;
    sy->times = 1;
    sy->occurs_flg = 0;
    sy->flags.just_r = 0;
    sy->flags.separate_sign = 0;
    sy->flags.leading_sign = 0;
    sy->flags.blank = 0;
    sy->flags.value = 1;
    sy->son = sy->brother = NULL;
    picture[0] = 'S';
    picture[1] = 1;
    picture[2] = '9';
    picture[3] = 6;
    picture[4] = 0;
    tmp = curr_field;
    curr_field = sy;

    curr_field->value = ly;
    curr_field->value2 = ly;

    update_field(curr_field);
    close_fields();
    curr_field = tmp;

    tmp = NULL;
    ly = NULL;

}

/*
 * Define a temp field of the desired type and desired lenght
 */
struct sym *
define_temp_field(char desired_type, int desired_len)
{
    struct sym *sy, *tmp;
    /*        fprintf(stderr,"begin define temp %c\n",desired_type); */
#ifdef DEBUG_COMPILER
    fprintf(o_src, "#define_temp_field:%c,%d,SO:%d\n",
            desired_type, desired_len, stack_offset);
#endif
    sy = malloc(sizeof (struct sym));
    memset(sy, 0, sizeof (struct sym));
    sy->litflag = 0;
    sy->name = "%noname%";
    sy->len = desired_len;
    sy->decimals = 0; /* suppose no decimals yet */
    sy->pscale = 0;
    sy->level = 1;
    sy->type = desired_type;
    sy->redefines = NULL;
    sy->parent = NULL;
    sy->linkage_flg = 0;
    sy->sec_no = SEC_DATA; /* not optimal; should be in stack */
    /* sy->sec_no=SEC_STACK; */
    sy->times = 1;
    sy->occurs_flg = 0;
    sy->occurs = NULL;
    sy->flags.just_r = 0;
    sy->flags.separate_sign = 0;
    sy->flags.leading_sign = 0;
    sy->flags.blank = 0;
    sy->son = sy->brother = NULL;
    switch (desired_type)
    {
        case DTYPE_ALPHANUMERIC:
            picture[0] = 'X';
            picture[1] = (char) sy->len; /* this make the max 255 */
            picture[2] = 0;
            break;
        case DTYPE_BININT: /* Make it signed */
            picture[0] = 'S';
            picture[1] = 1;
            picture[2] = '9';
            picture[3] = 9;
            picture[4] = 0;
            break;
        default:
            picture[0] = '9';
            picture[1] = (char) sy->len; /* this make the max 255 */
            picture[2] = 0;
            break;
    }
    tmp = curr_field;
    curr_field = sy;

    piccnt = sy->len;
    update_field(curr_field);
    close_fields();
    curr_field = tmp;
    tmp = NULL;

    /*        fprintf(stderr,"end define_temp_field: %c\n",desired_type); */
    return sy;
}

int
define_implicit_field(struct sym *sy, struct sym *sykey, int idxlen)
{
    int i = 1, /*m=0, d,*/ r = 0;
    struct sym *tmp = NULL;
    char tmp_picture[3];
    struct index_to_table_list *i2t;

    /*  Fix me:
     *  This is a fix to ensure that indexes are defined as int (4 bytes)
     *  For some reason if defined otherwise (1, 2 bytes) the search all
     *  will not work.
     */

#if 0
    for (i = 1; i < idxlen; i = i * 10)
    {
        m++;
    }
    d = idxlen;
    while (d != 0)
    {
        m++;
        i = i * 10;
        d = idxlen / i;
    }
#endif

    /*  Fix me:
     *  This is a fix to ensure that indexes are defined as int (4 bytes)
     */
    /* sy->len=m; */
    sy->len = 4;

    sy->decimals = 0; /* suppose no decimals yet */
    sy->pscale = 0;
    sy->level = 1;
    sy->type = DTYPE_BININT; /* assume numeric "usage is comp" item */
    sy->redefines = NULL;
    sy->linkage_flg = 0; /* should not go in the linkage section, never! */
    /*        sy->sec_no=SEC_STACK; */
    sy->sec_no = default_sec_no;
    sy->times = 1;
    sy->occurs_flg = 0;
    sy->son = sy->brother = NULL;
    sy->flags.is_pointer = 0;
    sy->flags.blank = 0;

    memcpy(tmp_picture, picture, 3);
    picture[0] = '9';

    /*  Fix me:
     *  This is a fix to ensure that indexes are defined as int (4 bytes)
     */
    /* picture[1] = (char)m; */
    picture[1] = (char) 8;
    picture[2] = 0;
    tmp = curr_field;
    curr_field = sy;
    update_field(curr_field);
    close_fields();
    curr_field = tmp;
    memcpy(picture, tmp_picture, 3);
    tmp = NULL;

    i2t = malloc(sizeof (struct index_to_table_list));
    if (i2t == NULL)
    {
        return 0;
    }
    i2t->next = NULL;

    i = strlen(sy->name);
    i2t->idxname = malloc(i + 1);
    if (i2t->idxname == NULL)
    {
        free(i2t);
        i2t = NULL;
        return 0;
    }
    strcpy(i2t->idxname, sy->name);

    i = strlen(curr_field->name);
    i2t->tablename = malloc(i + 1);
    if (i2t->tablename == NULL)
    {
        free(i2t->idxname);
        free(i2t);
        i2t = NULL;
        return 0;
    }
    strcpy(i2t->tablename, curr_field->name);

    i2t->seq = '0'; /* no sort sequence is yet defined for the table */
    i2t->keyname = NULL;
    if (sykey != NULL)
    {

        if (sykey->level == -1)
        {
            i2t->seq = '1';
        }

        if (sykey->level == -2)
        {
            i2t->seq = '2';
        }

        i = strlen(sykey->name);
        i2t->keyname = malloc(i + 1);
        if (i2t->keyname == NULL)
        {
            free(i2t->idxname);
            free(i2t->tablename);
            free(i2t);
            return 0;
        }
        strcpy(i2t->keyname, sykey->name);
    }

    if (index2table == NULL)
    {
        index2table = i2t;
    }
    else
    {
        i2t->next = index2table;
        index2table = i2t;
    }

#ifdef DEBUG_COMPILER
    fprintf(o_src, "#trace (define_implicit_field): index '%s' table '%s' tablekey '%s' sequence '%c'\n",
            i2t->idxname,
            i2t->tablename,
            i2t->keyname,
            i2t->seq
            );
#endif

    i2t = NULL;

    return r;
}

struct sym*
determine_table_index_name(struct sym *sy)
{
    struct sym *rsy = NULL;
    struct index_to_table_list *i2t;

    i2t = index2table;
    while (i2t != NULL)
    {
        if (strcmp(i2t->tablename, sy->name) == 0)
        {
            rsy = lookup(i2t->idxname, SYTB_VAR);
            i2t = NULL;
        }
        else
        {
            i2t = i2t->next;
        }
    }

#ifdef DEBUG_COMPILER
    if (rsy == NULL)
    {
        fprintf(o_src, "#trace (determine_table_index_name): table name '%s' index name '(NULL)'\n",
                sy->name
                );
    }
    else
    {
        fprintf(stderr, "trace (determine_table_index_name): table name '%s' index name '%s'\n",
                sy->name,
                rsy->name
                );
    }
#endif
    return rsy;
}

/* walter
 verify if the variable is in the occurs  */
int
in_occurs(struct sym *syfield)
{
    struct sym *sy;

    sy = syfield;
    while (sy && sy->occurs_flg == 0)
    {
        sy = sy->parent;
    }
    if (!sy) return 0;
    return 1;
}

void
define_field(int level, struct sym *sy)
{
    struct sym *tmp;
    struct sym *tmp1 = sy;
    struct sym *tmp2;

    if (sy == NULL)
    {
        sy = malloc(sizeof (struct sym));
        sy->name = "%noname%";
    }
    if (level == 88)
    {
        sy->type = '8';
        sy->defined = 1;
        sy->len = 0;
        sy->decimals = 0;
        sy->pscale = 0;
        sy->level = level;
        sy->linkage_flg = at_linkage;
        sy->sec_no = 0;
        sy->times = 1;
        sy->occurs_flg = 0;
        sy->flags.just_r = 0;
        sy->flags.separate_sign = 0;
        sy->flags.leading_sign = 0;
        sy->flags.blank = 0;
        sy->son = sy->brother = NULL;
        if (curr_field->level == 88)
        {
            curr_field->brother = sy;
            sy->parent = curr_field->parent;
        }
        else
            sy->parent = curr_field;
        curr_field = sy;
        check_fields(sy);
        return;
    }
    if (level == 1 || level == 77 || level == 66)
        curr_sec_no = default_sec_no;
    sy->len = 0;
    sy->decimals = 0; /* suppose no decimals yet */
    sy->pscale = 0;
    sy->level = level;
    sy->redefines = NULL;
    sy->linkage_flg = at_linkage;
    sy->sec_no = (at_linkage ? SEC_ARGS : curr_sec_no);
    sy->times = 1;
    sy->occurs_flg = 0;
    sy->flags.just_r = 0;
    sy->flags.blank = 0;
    sy->son = sy->brother = NULL;
    sy->picstr = NULL;

    /* Determine location in hierarchy */
    tmp = curr_field;
    if (tmp && ((level == 1) || (level == 77) || (level == 66)))
        close_fields();
    if (!tmp && (level > 1) && (level < 49))
    {
        yyerror("data field hierarchy broken");
    }
    if (level != 77 && level != 66)
    {
        while (tmp != NULL && tmp->level > level)
        {
            tmp1 = tmp;
            tmp = tmp->parent;
        }
        if (tmp == NULL)
            sy->parent = NULL;
        else if (tmp->level < level)
        {
            sy->parent = tmp;
            if (tmp->son == NULL)
                tmp->son = sy;
                /*else
                        yyerror("malformed data hierarchy");*/
            else
            {
                tmp1->brother = sy;
                sy->parent = tmp;
                sy->level = tmp1->level;
            }
        }
        else
        {
            tmp->brother = sy;
            sy->parent = tmp->parent;
        }
    }

    /* is it already defined ? */
    if ((tmp2 = lookup(sy->name, SYTB_VAR)) != NULL)
    {
        if (tmp2 != sy && tmp2->parent == NULL && sy->parent == NULL)
            yyerror("Variable %s already defined", tmp2->name);
    }

    /* Set initial values of inheritable fields */
    if (sy->parent)
    {
        struct sym *syp = sy->parent;
        sy->type = syp->type;
        sy->flags.separate_sign = syp->flags.separate_sign;
        sy->flags.leading_sign = syp->flags.leading_sign;
    }
    else
    {
        sy->type = DTYPE_DISPLAY;
        sy->flags.separate_sign = 0;
        sy->flags.leading_sign = 0;
    }

    curr_field = sy;
}

void
update_renames_field(struct sym *sy1, struct sym *sy2)
{
    struct sym *sy = curr_field;

    sy->son = NULL;
    sy->parent = sy1->parent;
    sy->redefines = sy1;
    if (sy2 == NULL)
    {
        sy->type = sy1->type;
        sy->location = sy1->location;
        sy->len = sy1->len;
        if (sy1->type == DTYPE_GROUP)
        {
            sy->pic = 0;
            sy->descriptor = literal_offset;
            literal_offset += FLD_DESC_SIZE0;
        }
        else
        {
            /* We should really reuse the original descriptor */
            /* sy->descriptor = sy1->descriptor; */
            sy->picstr = sy1->picstr;
            sy->descriptor = literal_offset;
            literal_offset += FLD_DESC_SIZE1;
            sy->pic = literal_offset;
            literal_offset += (strlen(sy1->picstr) + 1);
        }
    }
    else
    {
        sy->type = DTYPE_GROUP;
        sy->location = sy1->location;
        sy->len = sy2->location - sy1->location + sy2->len;
        sy->pic = 0;
        sy->descriptor = literal_offset;
        literal_offset += FLD_DESC_SIZE0;
    }
    save_field_in_list(sy);
    curr_field = NULL; /* so that close_fields won't be invoked */
}

struct sym *
alloc_filler(void)
{
    char s[15];
    struct sym *sy;
    sprintf(s, "FIL$%05d", filler_num++);
    sy = install(s, SYTB_VAR, 0);
    sy->defined = 1;
    return sy;
}

struct selsubject *
save_sel_subject(int type, struct selsubject *ssubj, struct sym *sy)
{
    struct selsubject *tmp = malloc(sizeof (struct selsubject));
    struct selsubject *tmp1;
    tmp->type = type;
    tmp->var = sy;
    tmp->next = NULL;
    if (ssubj != NULL)
    {
        tmp1 = ssubj;
        while (tmp1->next)
            tmp1 = tmp1->next;
        tmp1->next = tmp;
        return ssubj;
    }
    return tmp;
}

void
compute_subject_set_size(struct selsubject *ssbj)
{
    int stack_adjust = 0;
    while (ssbj != NULL)
    {
        if (ssbj->type == SSUBJ_EXPR)
        {
            stack_adjust += 8;
        }
        else if (ssbj->type == SSUBJ_COND)
        {
            stack_adjust += 4;
        }
        ssbj = ssbj->next;
    }
    inner_stack_size += stack_adjust;
}

void
release_sel_subject(int label, struct selsubject *ssbj)
{
    struct selsubject *tmp;
    int stack_adjust = 0;
    fprintf(o_src, ".L%d:\t# EVALUATE end\n", label);
    while (ssbj != NULL)
    {
        if (ssbj->type == SSUBJ_EXPR)
        {
            stack_adjust += 8;
        }
        else if (ssbj->type == SSUBJ_COND)
        {
            stack_adjust += 4;
        }
        tmp = ssbj;
        ssbj = ssbj->next;
        free(tmp);
    }
    if (stack_adjust)
        fprintf(o_src, "\taddl\t$%d, %%esp\n", stack_adjust);
    /* we're leaving this level of stack frame */
    inner_stack_size -= stack_adjust;
}

int
check_fields(struct sym *sy)
{
    struct sym *tmp;
//    int len;
    int elen;
    char *p; /* walter */
    int sylen, i, isd; /* walter */

    /* Only fields that are signed, class numeric, and usage DISPLAY may
     * leave the sign flags on. */
    if ((sy->type != DTYPE_DISPLAY) || (sy->picstr[0] != 'S'))
    {
        sy->flags.separate_sign = 0;
        sy->flags.leading_sign = 0;
    }
    /* Recursively check children */
    if (sy->son != NULL)
    {
//        len = 0;
        for (tmp = sy->son; tmp != NULL; tmp = tmp->brother)
        {
            check_fields(tmp);
        }
    }
    /*
            These tests are done in YACC
        
            if (sy->type == DTYPE_DISPLAY && sy->len > 18) {
               yyerror("Maximum elementary numeric item size of %s > 18 digits exceeded", sy->name);
            }
            if (sy->type == DTYPE_ALPHANUMERIC && sy->len > 12750)
                    yyerror("Maximum elementary alphanumeric item size of %s > 12750 exceeded", sy->name);
     */
    if (sy->level == 88)
    {
        if (sy->parent->len == 0)
            yyerror("Parent variable of 88 has no storage");
    }
    if (sy->value != NULL)
    {
        sylen = sy->value->len; /* walter */
        switch (sy->type)
        { /* test if numbers initiates with 0 and correct the error below walter */
            case DTYPE_DISPLAY:
            case DTYPE_BININT:
            case DTYPE_PACKED:
            case DTYPE_EDITED:
            case DTYPE_FLOAT:
                p = sy->value->name;
                i = sylen;
                sylen = 0;
                isd = 0;
                while (i)
                {
                    switch (*p++)
                    {
                        case '0': if (isd) sylen++;
                            break;
                        default: sylen++;
                            isd = 1;
                            break;
                    }
                    i--;
                }
                break;
        }

        if (sylen > (elen = get_max_edt_len(sy)))
        {
            HTG_temporary_severity = 4;
            yyerror("Value (length %d) of symbol %s is greater than it's picture (%d)", sylen, sy->name, elen);
            HTG_temporary_severity = 8;
        }
        if (sy->value->type == DTYPE_ALPHANUMERIC &&
                (sy->type == DTYPE_DISPLAY || sy->type == DTYPE_BININT))
            if (!sy->flags.blank)
                yyerror("Invalid value type for symbol %s", sy->name);
    }
    return 0;
}

int
set_field_value_sw(struct sym *sy, int times)
{
    struct sym *tmp;
    unsigned int res;

    struct
    {
        unsigned int v : 1, sv : 1, tmpv : 1, tmpsv : 1;
    } f;

    f.v = 0;
    f.sv = 0;
    if (sy->son != NULL)
    {
        for (tmp = sy->son; tmp != NULL; tmp = tmp->brother)
        {
            res = set_field_value_sw(tmp, times);
            f.v = f.v || res;
        }
    }
    sy->flags.value = f.v = f.v || sy->value != NULL;
    sy->flags.spec_value = f.sv = f.v;

    /* fprintf(stderr,"set_field_value_sw: %s -> %d,%d\n",sy->name,f.v,f.sv); */
    /*        return f.v*2 + f.sv; */
    return f.v;
}

int
set_field_length(struct sym *sy, int times)
{
    struct sym *tmp;
    int len, tmplen;
    if (sy->son != NULL)
    {
        len = 0;
        sy->type = DTYPE_GROUP;
        for (tmp = sy->son; tmp != NULL; tmp = tmp->brother)
        {
            tmplen = tmp->times * set_field_length(tmp, times);
            if (tmp->redefines == NULL)
                len += tmplen;
        }
        sy->len = len;
    }
    len = symlen(sy) + sy->slack;
    /* fprintf(stderr,"set_field_length: %s -> %d\n",sy->name,len*times); */
    return len * times;
}

unsigned
field_alignment(struct sym *sy, unsigned location)
{
    unsigned slack_bytes = 0, mod_loc;

    if (sy->flags.sync == 0) return 0;
    switch (sy->type)
    {
        case DTYPE_BININT:
            mod_loc = (location - curr_01_location) % symlen(sy);
            slack_bytes = (mod_loc == 0 ? 0 : symlen(sy) - mod_loc);
            break;
    }
#if 0
#ifdef DEBUG_COMPILER        
    fprintf(o_src, "#fa: %d, %d, %d, %d, %d\n", curr_01_location, location, symlen(sy), mod_loc, slack_bytes);
#endif        
#endif
    return slack_bytes;
}

void
set_field_location(struct sym *sy, unsigned location)
{
    struct sym *tmp;

    /* fprintf(stderr,"set_field_location: %s -> %d\n",sy->name,location); */
    if (sy->level == 1) curr_01_location = location;
    /********* allocate field descriptor *************/
    sy->descriptor = literal_offset;
    if (HTG_libcob)
    {
        literal_offset += (sy->type == DTYPE_GROUP ? CFLD_DESC_SIZE0 : CFLD_DESC_SIZE1);
    }
    else
    {
        literal_offset += (sy->type == DTYPE_GROUP ? FLD_DESC_SIZE0 : FLD_DESC_SIZE1);
    }
    /********* generate picture for field ************/
    if (sy->type != DTYPE_GROUP)
    {
        sy->pic = literal_offset;
        literal_offset += (strlen(sy->picstr) + 1);
    }
    else
        sy->decimals = sy->pic = 0;
    save_field_in_list(sy);
    if (sy->redefines != NULL)
    {
        location = sy->redefines->location;
        sy->slack = 0;
        sy->flags.in_redefinition = 1;
    }
    else
    {
        sy->slack = field_alignment(sy, location);
        location += sy->slack;
        sy->flags.in_redefinition = 0;
    }
    if (sy->parent != NULL && sy->parent->flags.in_redefinition) sy->flags.in_redefinition = 1;
    sy->location = location;
    for (tmp = sy->son; tmp != NULL; tmp = tmp->brother)
    {
        set_field_location(tmp, location);
        if (tmp->redefines == NULL)
        {
            if (tmp->sec_no == SEC_STACK)
            {
                location -= (symlen(tmp) + tmp->slack) * tmp->times;
                /* negative for it's at the stack */
            }
            else
            {
                location += (symlen(tmp) + tmp->slack) * tmp->times;
            }
        }
    }
}

void
scr_set_column(struct scr_info *si, struct sym *sy, int plus_minus)
{
    int val;
    si->column = 0;
    si->column_var = NULL;
    si->column_sign = plus_minus;
    if (sy->litflag == 1)
    {
        si->column_var = NULL;
        val = atoi(sy->name);
        if (val == 0)
            yyerror("line could not be 0");
        si->column = val;
    }
    else
    {
        if (!(sy->defined))
            yyerror("variable not defined %s ", sy->name);
        if (sy->type == DTYPE_ALPHANUMERIC)
            yyerror("variable %s must be numeric", sy->name);
        si->column_var = sy;
    }
}

void
scr_set_line(struct scr_info *si, struct sym *sy, int plus_minus)
{
    int val;
    si->line = 0;
    si->line_var = NULL;
    si->line_sign = plus_minus;
    if (sy->litflag == 1)
    {
        si->line_var = NULL;
        val = atoi(sy->name);
        if (val == 0)
            yyerror("line could not be 0");
        si->line = val;
    }
    else
    {
        if (!(sy->defined))
            yyerror("variable not defined %s ", sy->name);
        if (sy->type == DTYPE_ALPHANUMERIC)
            yyerror("variable %s must be numeric", sy->name);

        si->line_var = sy;
    }
}

/*void scr_push_display_position(struct lit *lit)*/
void
scr_push_display_position(struct sym *sy)
{
    int len = 0, pos, lin, col;
    struct lit *literal;

    if (sy->litflag)
    {
        /* is a literal */
        literal = (struct lit *) sy;
        len = strlen(literal->name);
        switch (len)
        {
            case 4:
                pos = atoi(literal->name);
                lin = pos / 100;
                col = pos - (100 * lin);
                push_immed(lin);
                push_immed(col);
                asm_call("tcob_goxy");
                break;
            case 6:
                pos = atoi(literal->name);
                lin = pos / 1000;
                col = pos - (1000 * lin);
                push_immed(lin);
                push_immed(col);
                asm_call("tcob_goxy");
                break;
            default:
                yyerror("DISPLAY AT must be followed by a 4 digits or 6 digits integer");
                break;
        }
    }
    else
    {
        /* is a variable */
        switch (sy->len)
        {
            case 4:
                push_immed(4);
                gen_loadloc(sy);
                asm_call("tcob_goxy_variable");
                break;
            case 6:
                push_immed(6);
                gen_loadloc(sy);
                asm_call("tcob_goxy_variable");
                break;
            default:
                yyerror("DISPLAY AT must be followed by a 4 digits or 6 digits variable");
                break;
        }


    }
}

/*************** report section ******************/

void
save_report(struct sym *rep, struct sym *file)
{
    struct rd *rd = (struct rd *) rep;
    struct list *item = malloc(sizeof (struct list));
    item->var = rd;
    item->next = report_list;
    report_list = item;
    rd->file = file;
    rd->type = 'W';
    rd->controls = rd->items = NULL;
    rd->page_limit = 66;
    rd->heading = 1;
    rd->footing = 66;
    rd->first_detail = rd->last_detail = 1;
}

void
update_report_field(struct sym *sy)
{
    update_field(curr_field);
    sy->type = 'Q';
}

void
update_screen_field(struct sym *sy, struct scr_info *si)
{
    struct sym *tmp;
    char *pic;
    update_field(curr_field);
    sy->type = DTYPE_ACCEPT_DISPLAY;
    sy->scr = si;
    si->label = screen_label++;
    /* if picture is empty (implicit filler), and there is a
            value declared, create its picture from value literal. */

    if (*(sy->picstr) == 0 && sy->value != NULL)
    {
        tmp = (struct sym *) sy->value;
        pic = sy->picstr = malloc(3);
        *pic++ = 'X';
        *pic++ = strlen(tmp->name);
        *pic = 0;
        sy->len = strlen(tmp->name);
    }
}

void
update_field(struct sym *sy)
{
    if (sy->level != 88 && sy->level != 66)
    {
        gen_picture();
    }
    /* printf("upd_flds:symbol: %s, %d, piccnt: %d, %d\n", sy->name,
      sy->len, piccnt,pscale); */
    /* Physical sizes for BINARY and FLOAT types are not (generally)
     * affected by the PICTURE. */
    if ((sy->type != DTYPE_BININT)
            && (sy->type != DTYPE_FLOAT))
    {
        if (piccnt == 1 && abs(pscale) == 1)
            sy->len = 1; /* only one P in the picture */
        else
            sy->len = piccnt - abs(pscale);
    }
    /* SIGN IS ... SEPARATE only affects field length when class is numeric,
     * usage is DISPLAY, and field is signed.  However, sign flags must be
     * temporarily retained in case this is a group item. */
    if ((sy->type == DTYPE_DISPLAY)
            && (sy->picstr[0] == 'S')
            && (sy->flags.separate_sign))
    {
        sy->len++;
    }
    /* fprintf(stderr,"symbol: %s, piccnt: %d, %d\n", sy->name,
      piccnt,pscale); */
    /* update COMP field length (but not BINARY-<something>) */
    if ((sy->type == DTYPE_BININT)
            && (sy->len == 0))
    {
        sy->len = query_comp_len(sy);
    }
}

void
close_fields(void)
{
    struct sym *sy;
    int saved_length;
    int ns_offset = 0;
    if (curr_field == NULL) return;
    /* printf("close: %s, %d\n", curr_field->name, curr_field->len); */
    /********** locate level 01 field   **************/
    for (sy = curr_field; sy->parent != NULL; sy = sy->parent);
    if (sy->level != 1 && sy->level != 77 && sy->level != 66)
    {
        yyerror("field not subordinate to any other: %s", sy->name);
    }
    /********** propagate value flags  *************/
    sy->flags.spec_value = set_field_value_sw(sy, 1);
    /********** update length of fields  *************/
    if (sy->linkage_flg)
    {
        linkage_offset += (set_field_length(sy, 1) * sy->times);
        set_field_location(sy, linkage_offset);
    }
    else if (sy->sec_no == SEC_DATA)
    {
        saved_length = (set_field_length(sy, 1) * sy->times);
        set_field_location(sy, data_offset);
        data_offset += saved_length;
    }
    else if (sy->sec_no >= SEC_FIRST_NAMED)
    {
        saved_length = (set_field_length(sy, 1) * sy->times);
        set_field_location(sy, ns_offset);
        ns_offset += saved_length;
    }
    else
    {
        stack_offset += (set_field_length(sy, 1) * sy->times);
        set_field_location(sy, stack_offset);
    }
    check_fields(sy);
    curr_field = NULL;
}

/*int
show_labels() {
        struct sym *sy,*sy1,*sy2;
        int i,j=0;
        FILE *f;
        f = fopen("show.labels","w");
        for (i=0;i<HASHLEN;i++) {
        for (sy=labtab[i];sy!=NULL;sy=sy->next) {
                if (sy->type == 'f') continue;
                sy1 = sy;
                while (sy1) {
                        fprintf(f,"Label: %s, defined: %d, type: %c, parent: %s\n",
                                sy1->name, sy1->defined, sy1->type,
                                sy1->parent ? sy1->parent->name : "(NULL)");
                        j++;
                        sy1=sy1->clone;
                }        
        }
    }
        fclose(f);
        return j;
}*/

char *
var_name(struct sym *sy)
{
    unsigned int n;
    n = MAXNAMEBUF;
    strcpy(name_buf, "");
    while (n > strlen(sy->name) + 4)
    {
        if (n < MAXNAMEBUF)
            strcat(name_buf, " OF ");
        strcat(name_buf, sy->name);
        n -= strlen(sy->name) + 4;
        if ((lookup(sy->name, SYTB_VAR)->clone == NULL)
                || (sy->parent == NULL))
            break;
        sy = sy->parent;
    }
    return name_buf;
}

/* save variable values, including 88-var range/values list */
void
set_variable_values(struct lit *v1, struct lit *v2)
{
    struct vrange /**vr,*/*new;
    if (curr_field->value == NULL)
    {
        curr_field->refmod_redef.vr = NULL;
        curr_field->value = v1;
        curr_field->value2 = v2;
        curr_field->flags.value = 1;
        curr_field->flags.spec_value = 1;
    }
    else
    {
        new = malloc(sizeof (struct vrange));
        new->value = v1;
        new->value2 = v2;
        /* spec_value is not used for 88 */
        new->next = curr_field->refmod_redef.vr;
        curr_field->refmod_redef.vr = new;
    }
}

void
assign_expr(struct sym *sy, int opt, char end)
{
    push_immed(opt);
    gen_loadvar(sy);
    if (end == '1')
    {
        stackframe_cnt += sizeof (double); /* value to be poped too */
    }
    asm_call("tcob_assign_double");
}

int
push_expr(struct sym *sy)
{
    int retcode;
#ifdef DEBUG_COMPILER
    fprintf(o_src, "##### push_expr begin\n");
#endif
    retcode = push_subexpr(sy);
#ifdef DEBUG_COMPILER
    fprintf(o_src, "##### push_expr end\n");
#endif
    return retcode;
}

void
alloc_file_entry(struct sym *f)
{
    f->record = stack_offset;
    f->sort_file = 0;
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# Allocate space for file '%s' Stack Addr: %d\n",
            f->name, stack_offset);
#endif
}

/*
 ** define a file, but don't generate code yet.
 ** (will be done later at dump_fdesc())
 */
void
gen_fdesc(struct sym *f, struct sym *r)
{
    int len;
    struct list *list, *templist;
    struct alternate_list *alt;
    list = (struct list *) malloc(sizeof (struct list));

    if (files_list == NULL)
    {
        files_list = list;
    }
    else
    {
        templist = files_list;
        while (templist->next != NULL)
        {
            templist = templist->next;
        }
        templist->next = list;
    }
    list->var = f;
    list->next = NULL;

    f->recordsym = r;
    while (r != NULL)
    {
        r->ix_desc = f;
        r = r->redefines;
    }
    len = sizeof (struct file_desc) - 10; /* suppose without indexes */
    /*        f->location = file_offset; */
    if (f->organization == 1)
    { /* indexed file */
        len += 10 + 2;
        /*  10 -> remaining of struct file_desc (only for indexed files)
                2 --> size of terminating "word -1| */
        /* now count each alternate description size */
        alt = (struct alternate_list *) f->alternate;
        while (alt)
        {
            len += sizeof (struct altkey_desc);
            alt = alt->next;
        }
    }
    f->fdesc = global_offset;
    global_offset += len;
    /*        file_offset += len; */
}

void
gen_status(struct sym *f)
{

    if (f->parent)
    {
        push_eax();
        gen_loadloc(f->parent);
        asm_call("tcob_save_status");
    }
}

void
gen_perform_decl(struct sym *f)
{
    struct sym *decl_sym = f->refmod_redef.declarative;
    int tmplabel;

    if (decl_sym)
    {
#ifdef DEBUG_COMPILER
        fprintf(o_src, "# decl: on %s\n", decl_sym->name);
#endif
        tmplabel = gen_check_zero();
        gen_perform(decl_sym);
        gen_dstlabel(tmplabel);
    }
}

/****** sort statement related functions *******/
struct sortfile_node *
alloc_sortfile_node(struct sym *sy)
{
    struct sortfile_node *sn;
    if (sy->type != 'F')
    {
        yyerror("only files can be found here");
        return NULL;
    }
    sn = malloc(sizeof (struct sortfile_node));
    sn ->next = NULL;
    sn->sy = sy;
    return sn;
}

struct sym *
create_status_register(char *name)
{
    struct sym *sy;
    char pic[] = {'9', 2, 0};
    sy = install(name, SYTB_VAR, 0);
    if (sy->type) return sy; /* it already exists */
    sy->type = DTYPE_DISPLAY;
    sy->picstr = malloc(strlen(pic) + 1);
    strcpy(sy->picstr, pic);
    sy->defined = 1;
    sy->occurs_flg = 0;
    sy->times = 1;
    sy->len = 2;
    sy->son = sy->brother = NULL;
    sy->linkage_flg = 0;
    sy->sec_no = SEC_DATA;
    sy->location = data_offset;
    data_offset += 2;
    sy->descriptor = literal_offset;
    literal_offset += FLD_DESC_SIZE1;
    sy->pic = literal_offset;
    literal_offset += strlen(pic) + 1;
    save_field_in_list(sy);
    return sy;
}

void
gen_sort_using(struct sym *f, struct sortfile_node *sn)
{
    struct sym *vstatus = create_status_register("SORT-RETURN");
    gen_save_sort_fields(f, NULL);
    push_immed(0);
    while (sn)
    {
        gen_loadloc(sn->sy->filenamevar);
        gen_save_filedesc(sn->sy);
        sn = sn->next;
    }
    asm_call("tcob_sort_using");
    /* save status returned by operation */
    push_eax();
    gen_loadloc(vstatus);
    asm_call("tcob_save_status");
}

void
gen_sort_giving(struct sym *f, struct sortfile_node *sn)
{
    struct sym *vstatus = create_status_register("SORT-RETURN");
    gen_save_sort_fields(f, NULL);
    push_immed(0);
    while (sn)
    {
        gen_loadloc(sn->sy->filenamevar);
        gen_save_filedesc(sn->sy);
        sn = sn->next;
    }
    asm_call("tcob_sort_giving");
    /* save status returned by operation */
    push_eax();
    gen_loadloc(vstatus);
    asm_call("tcob_save_status");
}

void
gen_sort(struct sym *f)
{
    struct sym *datafld;
    if ((f->recordsym))
    {
        gen_loadloc(f->filenamevar);
        gen_save_filevar(f, NULL);
        asm_call("tcob_sort_open");
        gen_status(f);
        gen_perform_decl(f);
        gen_close_sort(f);
    }
    else
    { /* walter */
        push_immed(0);
        if (f->sort_data)
        {
            datafld = (struct sym *) f->sort_data;
            while (datafld != NULL)
            {
                gen_loadloc(datafld); /* value of field */
                push_immed((int) datafld->direction);
                gen_loaddesc2(datafld, 1); /* field struct */
                datafld = (struct sym *) (datafld->sort_data);
                if (datafld == (struct sym *) f->sort_data)
                    datafld = NULL;
            }
        }
        if (f->occurs)
        {
            gen_loaddesc(f->occurs->depend); /* depending on */
            gen_loadloc(f->occurs->depend);
            push_immed((int) f->occurs->max); /* occurs n       times */
            push_immed((int) f->occurs->min); /* occurs initial times */
        }
        else
        {
            push_immed(0);
            push_immed(0);
            push_immed((int) f->times); /* occurs n       times */
            push_immed(1); /* occurs initial times */
        }
        push_immed((int) f->len);
        gen_loadloc(f);
        gen_loaddesc2(f, 1);
        asm_call("tcob_sort_mem");
    }
}

void
gen_open(int mode, struct sym *f)
{
    push_immed(mode);
    gen_loadloc(f->filenamevar);
    gen_save_filevar(f, NULL);
    asm_call("tcob_open");
    gen_status(f);
    gen_perform_decl(f);
}

void
gen_close_sort(struct sym *f)
{
    struct sym *sortf;
    /********** allocate memory for SORT descriptor ***********/
    save_field_in_list(f);
    f->descriptor = literal_offset;
    sortf = (struct sym *) (f->sort_data);
    while (sortf != NULL)
    {
        literal_offset += 2;
        sortf = (struct sym *) (sortf->sort_data);
    }
    literal_offset++;
}

void
gen_close(struct sym *f)
{
    gen_save_filevar(f, NULL);
    asm_call("tcob_close");
    gen_status(f);
    gen_perform_decl(f);
}

void
gen_return_stmt(struct sym *f, struct sym *buf)
{
    gen_save_filevar(f, buf);
    asm_call("tcob_sort_return");
    gen_status(f);
    gen_perform_decl(f);
}

int
gen_reads(struct sym *f, struct sym *buf, struct sym *key,
        int next_prev, int sel, int withlock)
{
    int r = 0;
    int t_next_prev = next_prev;
    /* NOTE:
     * While this is functional, it requires to be updated to trap more syntax errors
     */

    if (f->type != 'F')
    {
        yyerror("invalid variable \'%s\', file name expected", f->name);
        r++;
        return r;
    }

#if 0
    /* READ w/o [NOT] AT END or [NOT] INVALID KEY clauses */
    if (sel == 0)
    {
        if ((next_prev != 0) && (key != NULL))
        {
            yyerror("invalid clause NEXT found in READ statement with KEY IS data-name option");
            r++;
        }
        else
        {
        }

    }

    /* READ with [NOT] AT END clauses */
    if (sel == 1)
    {
    }

    /* READ with [NOT] INVALID KEY clauses */
    if (sel == 2)
    {
        if (next_prev != 0)
        {
            yyerror("invalid clause NEXT found in READ statement with INVALID KEY option");
            r++;
        }
        else
        {
        }
    }

    /* RETURN w/o [NOT] AT END clauses */
    if (sel == 4)
    {
    }

    /* RETURN with [NOT] AT END clauses */
    if (sel == 5)
    {
    }
#endif

    if (r == 0)
    {
        /* fprintf(stderr, "sel %d, np %d\n", sel, next_prev); */
        if (f->access_mode == ACC_SEQUENTIAL &&
                f->sort_file == 1)
        {
            gen_return_stmt(f, buf);
            return r;
        }
        if ((f->access_mode == ACC_SEQUENTIAL || f->access_mode == ACCEV_SEQUENTIAL) &&
                f->organization != ORG_LINESEQUENTIAL)
        {
            if (t_next_prev == 0) t_next_prev = 1;
            gen_read_next(f, buf, t_next_prev, withlock);
            return r;
        }
        if ((sel > -1) && (sel < 4))
        {
            /* if (sel == 1) t_next_prev = 1; */ /* AT END implies read next */
            if (t_next_prev > 0
                    && (f->organization == ORG_INDEXED || f->organization == ORG_RELATIVE)
                    && (f->access_mode == ACC_DYNAMIC || f->access_mode == ACC_SEQUENTIAL || f->access_mode == ACCEV_SEQUENTIAL
                    || f->access_mode == ACCEV_DYNAMIC)
                    )
            {
                gen_read_next(f, buf, t_next_prev, withlock);
            }
            else
            {
                gen_read(f, buf, key, withlock);
            }
        }
        else
        {
            if (f->organization != ORG_SEQUENTIAL)
                gen_read_next(f, buf, next_prev, withlock);
            else
                gen_return_stmt(f, buf);
        }
    }
    return r;
}

void
gen_unlock(struct sym *f)
{
    if (f->type != 'F')
    {
        yyerror("invalid variable \'%s\', file expected", f->name);
        return;
    }
    gen_save_filevar(f, NULL);
    asm_call("tcob_unlock");
}

void
gen_read(struct sym *f, struct sym *buf, struct sym *key,
        int withlock)
{
    struct rec_varying *rv = (struct rec_varying *) f->rec_varying;
    /*        gen_check_varying(f); */
    if (f->organization == ORG_RELATIVE)
    {
        /*gen_loadloc( f->ix_desc );
        fprintf(o_src,"\tmovl\t$c_base+%u, %%eax\n",
                f->ix_desc->descriptor);
        push_eax();*/
        gen_loadvar(f->ix_desc);
        asm_call("tcob_get_index");
        push_eax();
    }
    if (f->organization == ORG_INDEXED)
    {
        gen_loadvar(key);
    }
    /* pass the desc/address of reclen, if VARYING ... */
    if (rv != NULL)
        gen_loadvar(rv->reclen);
    else
        gen_loadvar(NULL);
    gen_save_filevar(f, buf);
    if (withlock == 1)
        asm_call1("tcob_setlock");
    else
        if (withlock == 2)
        asm_call1("tcob_ignorelock");
    asm_call("tcob_read");
    gen_status(f);
    /* gen_perform_decl(f); */ /* must be generated after At End or Invalid Key */
}

void
gen_read_next(struct sym *f, struct sym *buf, int next_prev,
        int withlock)
{
    struct rec_varying *rv = (struct rec_varying *) f->rec_varying;
    if (rv != NULL)
        gen_loadvar(rv->reclen);
    else
        gen_loadvar(NULL);
    gen_save_filevar(f, buf);
    if (next_prev == 1)
    {
        if (withlock == 1)
            asm_call1("tcob_setlock");
        else
            if (withlock == 2)
            asm_call1("tcob_ignorelock");
        asm_call("tcob_read_next");
    }
    else
    {
        if (withlock == 1)
            asm_call1("tcob_setlock");
        else
            if (withlock == 2)
            asm_call1("tcob_ignorelock");
        asm_call("tcob_read_prev");
    }
    gen_status(f);
    /* gen_perform_decl(f); */ /* must be generated after At End or Invalid Key */
}

void
gen_release(struct sym *r, struct sym *buf)
{
    struct sym *f;
    f = r->ix_desc;
    if (buf != NULL)
    {
        gen_move(buf, r);
    }
    gen_save_sort_fields(f, buf);
    asm_call("tcob_sort_release");
    gen_status(f);
    gen_perform_decl(f);
}

void
gen_write(struct sym *r, struct sym *advar, struct sym *buf, int opt)
{
    struct sym *f = r->ix_desc;
    struct rec_varying *rv = (struct rec_varying *) f->rec_varying;
    gen_check_varying(f);
    if (opt)
    {
        if (buf != NULL)
        {
            gen_move(buf, r);
        }
        if (advar != NULL)
            gen_loadvar(advar);
        if (rv != NULL)
            gen_loadvar(rv->reclen);
        else
            gen_loadvar(NULL);
        push_immed(opt);

        /*                gen_save_filevar( f,buf ); */
        /* Is this code correct ??? It works but ... */
        gen_save_filevar(f, r);

        asm_call("tcob_write_adv");

#if 0
        /* This code does not work !!! */

        if (rv != NULL)
            gen_loadvar(rv->reclen);
        else
            gen_loadvar(NULL);
        push_immed(opt);
        gen_save_filevar(f, buf);
        if (buf == NULL)
            asm_call("tcob_write_adv");
        else
        {
            gen_move(buf, r);
            /* asm_call("tcob_write_adv_from"); */
            asm_call("tcob_write_adv");
        }

#endif
    }
    else
    {
        if (f->organization == ORG_RELATIVE)
        {
            /*gen_loadloc( f->ix_desc );
            fprintf(o_src,"\tmovl\t$c_base+%u, %%eax\n",
                    f->ix_desc->descriptor);
            push_eax();*/
            gen_loadvar(f->ix_desc);
            asm_call("tcob_get_index");
            push_eax();
        }
        /* Handle Write From by moving the data and then setting Buf to NULL
         * only if it is not a relative record.
         */
        if ((buf != NULL) && (f->organization != ORG_RELATIVE))
        {
            gen_move(buf, r);
            buf = NULL;
        }
        if (rv != NULL)
            gen_loadvar(rv->reclen);
        else
            gen_loadvar(NULL);
        gen_save_filevar(f, buf);
        asm_call("tcob_write");
    }
    gen_status(f);
    gen_perform_decl(f);
}

void
gen_rewrite(struct sym *r, struct sym *buf)
{
    struct sym *f = r->ix_desc;
    struct rec_varying *rv = (struct rec_varying *) f->rec_varying;
    gen_check_varying(f);
    if (f->organization == ORG_RELATIVE)
    {
        /*gen_loadloc( f->ix_desc );
        fprintf(o_src,"\tmovl\t$c_base+%u, %%eax\n",
                f->ix_desc->descriptor);
        push_eax();*/
        gen_loadvar(f->ix_desc);
        asm_call("tcob_get_index");
        push_eax();
    }
    if (rv != NULL)
        gen_loadvar(rv->reclen);
    else
        gen_loadvar(NULL);
    gen_save_filevar(f, buf);
    asm_call("tcob_rewrite");
    gen_status(f);
    gen_perform_decl(f);
}

void
gen_start(struct sym *f, int cond, struct sym *key)
{
    gen_check_varying(f);
    if (f->organization == ORG_RELATIVE)
    {
        /*gen_loadloc( f->ix_desc );
        fprintf(o_src,"\tmovl\t$c_base+%u, %%eax\n",
                f->ix_desc->descriptor);
        push_eax();*/
        gen_loadvar(f->ix_desc);
        asm_call("tcob_get_index");
        push_eax();
    }
    else
    {
        gen_loadvar(key);
    }
    push_immed(cond);
    gen_save_filevar(f, NULL);
    asm_call("tcob_start");
    gen_status(f);
    gen_perform_decl(f);
}

void
gen_delete(struct sym *f)
{
    gen_check_varying(f);
    if (f->organization == ORG_RELATIVE)
    {
        /*gen_loadloc( f->ix_desc );
        fprintf(o_src,"\tmovl\t$c_base+%u, %%eax\n",
                f->ix_desc->descriptor);
        push_eax();*/
        gen_loadvar(f->ix_desc);
        asm_call("tcob_get_index");
        push_eax();
    }
    gen_save_filevar(f, NULL);
    asm_call("tcob_delete");
    gen_status(f);
    gen_perform_decl(f);
}

void
set_rec_varying_info(struct sym *f, struct lit *lmin,
        struct lit *lmax, struct sym *reclen)
{
    struct rec_varying *rv = malloc(sizeof (struct rec_varying));
    f->rec_varying = (char *) rv;
    rv->lmin = lmin;
    rv->lmax = lmax;
    rv->reclen = reclen;
}

void
gen_check_varying(struct sym *f)
{
    struct rec_varying *rv = (struct rec_varying *) f->rec_varying;
    if (rv != NULL)
    {
        gen_loadvar(rv->reclen);
        gen_loadvar((struct sym *) rv->lmax);
        gen_loadvar((struct sym *) rv->lmin);
        gen_save_filedesc(f);
        asm_call("tcob_check_varying");
    }
}

int
get_switch_number(struct sym *sy)
{
    return (sy->name[2] - '0');
}

void
gen_get_switches()
{
    struct list *l = switches_list;
    struct sym *svar;

    while (l != NULL)
    {
        svar = l->var;
        push_immed(get_switch_number(svar->ix_desc));
        gen_loadvar(svar);
        asm_call("tcob_get_switch");
        l = l-> next;
    }
}

void
gen_set_switch(struct sym *var, struct sym *sy)
{

    gen_move(var, sy);
    push_immed(get_switch_number(sy->ix_desc));
    gen_loadvar(sy);
    asm_call("tcob_set_switch");

}

struct list *
chain_var(struct sym *sy)
{
    vars_list = insert_list(vars_list, sy);
    return vars_list;
}

void
gen_push_using(struct sym *sy)
{
    struct parm_list *list;
    if (sy->type == 'F')
        yyerror("file could not be used as parameter in a CALL");
    list = (struct parm_list *) malloc(sizeof (struct parm_list));
    list->var = (void *) sy;
    list->next = parameter_list;
    list->location = 0;
    list->sec_no = 0;
    parameter_list = list;
}

void
gen_save_usings(struct gvar_list *gsylst)
{
    struct gvar_list *gl;

    for (gl = gsylst; gl->next != NULL; gl = gl->next)
    {
        gen_save_using(gl->u.sym);
    }
    gen_save_using(gl->u.sym);
}

void
gen_save_using(struct sym *sy)
{
    sy->linkage_flg = using_offset;
    using_offset += 4;
}

void
gen_save_chainings(struct gvar_list *gsylst)
{
    struct gvar_list *gl;

    for (gl = gsylst; gl->next != NULL; gl = gl->next)
    {
        gen_save_chaining(gl->u.sym);
    }
    gen_save_chaining(gl->u.sym);
}

void
gen_save_chaining(struct sym *sy)
{
    struct parm_list *list;
    if (sy->type == 'F')
        yyerror("only variables could be used as parameter in CHAINING");
    list = (struct parm_list *) malloc(sizeof (struct parm_list));
    list->var = (void *) sy;
    list->next = chaining_list;
    list->location = 0;
    list->sec_no = 0;
    chaining_list = list;
}

void
gen_chain(struct sym *v, int stack_size, int exceplabel)
{

    struct parm_list *list, *tmp;
    struct sym *cp;
#ifdef DEBUG_COMPILER
    fprintf(o_src, "#chain %s\n", v->name);
#endif
    push_immed(0);
    for (list = parameter_list; list != NULL; list = tmp)
    {
        cp = (struct sym *) list->var;
        gen_loadvar(cp);
        tmp = list->next;
        free(list);
    }
    parameter_list = NULL;
    gen_loadvar(v);
    asm_call("tcob_chain");

}

short
get_std_val(struct sym *sy)
{
    if (sy->value == NULL)
    {
        return 0;
    }
    else if (sy->value == spe_lit_ZE)
    {
        return 2;
    }
    else if (sy->value == spe_lit_SP)
    {
        return 3;
    }
    else if (sy->value == spe_lit_LV)
    {
        return 4;
    }
    else if (sy->value == spe_lit_HV)
    {
        return 5;
    }
    else
    {
        return 1;
    }
}

/*
 *  Count the number of items under the field sy
 *  if (sw_val) ???
 */
int
get_nb_fields(struct sym *sy_org, int sw_val)
{
    struct sym *tmp;
    int nb_fields = 1, tmpnf;
    char ftype;
    short val;
    /* walter 13-12-05 */
    //        char ftype = sy->type;
    struct sym *sy;
    int oc;

    sy = sy_org;
    oc = 0;
    if (sy->litflag == 2)
    {
        oc = 1;
        sy = ((struct vref *) sy)->sym;
        if (sy->litflag == 2)
            sy = ((struct vref *) sy)->sym;
    }
    /* fim walter */
    ftype = sy->type;

    if (sy->type == DTYPE_GROUP)
    {
        for (tmp = sy->son; tmp != NULL; tmp = tmp->brother)
        {
            tmpnf = get_nb_fields(tmp, sw_val);

            if (tmp->redefines == NULL)
                nb_fields += tmpnf;
        }
        /*	if(oc) // walter 13-12-05
                        return nb_fields;*/
    }
    else
    {
        /* Packed fields are presently considered non-homogenous */
        if (ftype == DTYPE_PACKED) ftype = '&';
        if (ftype == DTYPE_DISPLAY && sy->picstr[0] == 'S') ftype = '&';
        if (init_ctype == ' ') init_ctype = ftype;
        if (ftype != init_ctype && init_ctype != '&')
            init_ctype = '&';
        if (sw_val)
        {
            val = get_std_val(sy);
            if (init_val == -1) init_val = val;
            if (ftype == init_ctype && init_ctype != '&' &&
                    val != init_val)
                init_ctype = '&';
        }
    }
    if (oc) return nb_fields;
    else
        return nb_fields * sy->times;
}

/*
 * sy : field
 * initp : 0
 * init_loc : initial location 
 * nb_fields : number of fields 
 */
static int
_build_init_str(struct sym *sy, int initp,
        unsigned *init_loc, int nb_fields,
        struct sym *fsy, struct vref *ref)
{ // walter 13-12-05
    char mem_warn[] = "**** WARNING invading end of malloced memory";
    struct sym *tmp;
    int stidx = -1, endidx = -1;
    int i, j;
    struct sym *sy_org = NULL; //walter 13-12-05
    struct vref *refa; // walter 13-12-05

    if (initp >= nb_fields)
    {
        fprintf(stderr, "%s, f,sym: %s\n", mem_warn, sy->name);
        return initp;
    }
    // walter 13-12-05
    if (ref)
    {
        sy_org = malloc(sizeof (struct sym));
        refa = (struct vref *) sy_org;
        //sy_org=(struct sym*)create_subscripted_var( sy, ref );
        refa->litflag = 2;
        refa->sym = sy;
        refa->next = ref->next;
        //create_subscripted_var( struct sym * sy, struct vref *subs )
    }
    else
        sy_org = sy;
    // fim walter

    stidx = initp;
    istrp->ent[initp].sy = sy_org; // walter 13-12-05
    istrp->ent[initp].type = sy->type;
    istrp->ent[initp].value = sy->value;
    istrp->ent[initp].len = symlen(sy);
    istrp->ent[initp].location = *init_loc;
    if (sy->type != DTYPE_GROUP)
    {
        *init_loc += istrp->ent[initp].len;
    }
    initp++;
    if (sy->type == DTYPE_GROUP)
    {
        for (tmp = sy->son; tmp != NULL; tmp = tmp->brother)
        {
            if (tmp->redefines == NULL)
                initp = _build_init_str(tmp, initp, init_loc, nb_fields, fsy, ref); // walter 13-12-05
        }
    }
    endidx = initp;
    if (ref && fsy && fsy == sy) // only for these ocorrency walter 13-12-05
        return initp;

    for (i = 1; i < sy->times; i++)
    {
        if (initp >= nb_fields)
        {
            fprintf(stderr, "%s, i,sym: %s\n", mem_warn, sy->name);
            break;
        }
        for (j = stidx; j < endidx; j++)
        {
            if (initp >= nb_fields)
            {
                fprintf(stderr, "%s, j,sym: %s\n", mem_warn, sy->name);
                break;
            }
            istrp->ent[initp].sy = istrp->ent[j].sy;
            istrp->ent[initp].type = istrp->ent[j].type;
            istrp->ent[initp].value = istrp->ent[j].value;
            istrp->ent[initp].len = istrp->ent[j].len;
            istrp->ent[initp].location = *init_loc;
            if (istrp->ent[j].type != DTYPE_GROUP)
                *init_loc += istrp->ent[initp].len;
            initp++;
        }
    }

    return initp;
}

int
build_init_str(struct sym *sy_org, int nb_fields)
{
    unsigned init_loc;
    /* walter 13-12-05 */
    struct sym *sy = NULL, *ref = NULL;
    struct vref *ref1 = NULL;
    int i;

    sy = sy_org;
    init_loc = sy->location;
    i = 0;
    if (sy->litflag == 2)
    {
        ref1 = ((struct vref *) sy);
        ref = ((struct vref *) sy)->next->sym;
        sy = ((struct vref *) sy)->sym;
        if (sy->litflag == 2)
            sy = ((struct vref *) sy)->sym;
        if (ref->litflag == 1)
        { // index by literal
            i = atoi(ref->name);
            init_loc = ((i - 1) * sy->len) + sy->location;
            ref = NULL;
        }
    }
    /* fim walter */
    return _build_init_str(sy, 0, &init_loc, nb_fields, sy, ref1);
}

void
gen_from_init_str(int nb_fields)
{
    int i;

    for (i = 0; i < nb_fields; i++)
    {
        unsigned temp_loc = istrp->ent[i].sy->location;
        istrp->ent[i].sy->location = istrp->ent[i].location;
        gen_init_str(istrp->ent[i].sy, istrp->ent[i].type, istrp->ent[i].len);
        istrp->ent[i].sy->location = temp_loc;
    }
}

/*
 *  Initialize field 'sy' of type 'init_ctype' and of length 'len' 
 *
 */
void
gen_init_str(struct sym *sy, char init_ctype, int len)
{
#ifdef DEBUG_COMPILER
    fprintf(o_src, "# init_str %s, type %c, len %d, loc %d\n", sy->name, init_ctype, len, sy->location);
#endif

    switch (init_ctype)
    {
        case DTYPE_DISPLAY:
        case DTYPE_PACKED:
            if (sy->value != NULL)
                gen_move_init((struct sym *) sy->value, sy); /* initial value */
            else
                gen_move((struct sym *) spe_lit_ZE, sy);
            break;

        case DTYPE_BININT:
            if (sy->type == DTYPE_BININT)
            {
                if (sy->value != NULL)
                    gen_move_init((struct sym *) sy->value, sy); /* initial value */
                else
                    gen_move((struct sym *) spe_lit_ZE, sy);
            }
            else
            {
                if (sy->value != NULL)
                    gen_move_init((struct sym *) sy->value, sy); /* initial value */
                else
                    gen_move((struct sym *) spe_lit_LV, sy);
            }
            break;

        default:
            if (sy->value != NULL)
                gen_move_init((struct sym *) sy->value, sy); /* initial value */
            else
                gen_move((struct sym *) spe_lit_SP, sy);
            break;
    }
}

/*
 *  Generate an initialize field 
 *
 */
void
gen_initializes(struct gvar_list *gsylst)
{
    struct gvar_list *gl;

    for (gl = gsylst; gl->next != NULL; gl = gl->next)
    {
        gen_initialize(gl->u.sym, 1);
    }
    gen_initialize(gl->u.sym, 1);
}

/* walter 13-12-05 
void gen_initializes_verb(struct gvar_list *gsylst, struct lit *init_alphab, struct lit *init_alpha, struct lit *init_alphaedt, struct lit *init_num, struct lit *init_numedt) {
   struct gvar_list *gl;
        unsigned int idx=0;

        for(gl=gsylst; gl->next!=NULL; gl=gl->next) {
                gen_move_first(gl->u.sym, 0, 0, &idx);
        }
        gen_move_first(gl->u.sym, 0, 0, &idx);
        return;
}

unsigned int gen_move_first(struct sym *sy, unsigned int loc, unsigned int size, unsigned int *idx) {
        struct sym *var, *tmp, *cop, *ref;
        int subs, i, ntimes, bSign=0;
        unsigned char cDigit;
        char *valor;
        unsigned int loc_cop=0;

        if(sy==NULL) return loc;
        var=sy; // Make sure BLANK test is done on a sym struct, and not a vref struct
// litflag
//		1-literal
//		2-variable
//		4-refmod
//		5-expr
//		,-end of subscripted
//		+ - -subscript arith
//
        if(var->litflag==4 || var->litflag==2 || var->litflag==4) {
                gen_subscripted( (struct vref *)var );
//		ref=((struct vref *)var)->next->sym;
//		valor=ref->name;
//		if(!ref->litflag)
//			valor=ref->value->name;
// integer's name is just it's value in ascii
//		if(*valor!='%') { // eca
//			for(i=0; (cDigit = valor[i]); i++) {
//				if(cDigit=='}') {
//					cDigit=0;
//				} else if(cDigit=='{') {
//					cDigit=0;
//					bSign=1;
//				} else if((cDigit>='A') && (cDigit<='I')) {
//					cDigit-='A'-1;
//				} else if ((cDigit>='J') && (cDigit<='R')) {
//					cDigit-='J'-1;
//					bSign=1;
//				} else if(isdigit(cDigit)){
//					cDigit-='0';
//				} else
//					cDigit=0;
//				*idx=(*idx * 10) + cDigit;
//			}
//		}
                var=((struct vref *)var)->sym;
                if(var->litflag==2)
                        var=((struct vref *)var)->sym;
        }

        if(var->flags.external) return loc;
        if(var->type == DTYPE_GROUP) {
                if(loc==0) loc=var->location;
                ntimes=var->times;
                if(*idx) ntimes=1;
                do {
                        tmp=var->son;
                        while(tmp!=NULL) {
                                if(tmp->redefines) {
                                        loc=gen_move_first(tmp, tmp->location, var->len, idx);
                                } else {
                                        loc=gen_move_first(tmp, loc, var->len, idx);
                                }
                                tmp=tmp->brother;
                        }
                        ntimes--;
                } while(ntimes);
                return loc;
        } else {
                if(loc==0) {
                        loc=var->location;
                        ntimes=var->times;
                }
        }
        cop = malloc(sizeof(struct sym));
        memcpy(cop, var, sizeof(struct sym));
        if(*idx) (*idx)--;
        while(*idx) {
                loc+=size;
                (*idx)--;
        }
        i = cop->times;
        while(i--) {
                cop->location=loc;
                gen_init_str(cop, cop->type, 1);
                loc += cop->len;
        }
        free(cop);
        return loc;
}
fim walter */

void
gen_initialize(struct sym *sy_start, int from_initializes)
{
    /*struct sym *sy;*/
    int nb_fields;
    struct init_str init_templ;
    /*        Possible optimization:
     *        1) Compress the init sequence to reduce the number
     *           of elementary moves.
     */
    if (sy_start == NULL) return;
    if (sy_start->flags.external && !from_initializes) return; // walter 13-12-05

#ifdef DEBUG_COMPILER
    fprintf(o_src, "# INITIALIZE %s, type %c\n", sy_start->name, sy_start->type);
#endif
    init_ctype = ' ';
    nb_fields = get_nb_fields(sy_start, 0);
    if (init_ctype != '&' && init_ctype != ' ')
    {
        gen_init_str(sy_start, init_ctype, symlen(sy_start));
        return;
    }
#ifdef DEBUG_COMPILER        
    fprintf(o_src, "#  (2) istrp = malloc(%d) nb_fields = %d\n",
            nb_fields * sizeof (init_templ), nb_fields);
#endif
    istrp = malloc(nb_fields * sizeof (init_templ));
    build_init_str(sy_start, nb_fields);
    gen_from_init_str(nb_fields);
    free(istrp);
    istrp = NULL;
#ifdef DEBUG_COMPILER        
    fprintf(o_src, "# END_INITIALIZE\n");
#endif
}

/*
 * Cancel statement
 * The parameter is the field or literal containing the name of the routine to cancel
 * if the parameter is NULL, a is a CACNEL ALL
 */

void
gen_cancel(struct sym *routine_name)
{
    if (routine_name)
    {
        gen_loadvar(routine_name);
        asm_call("tcob_cancel");
    }
    else
    {
        asm_call("tcob_cancel_all");
    }
}

/*
 * GOBACK statement.
 * If is a module generate EXIT PROGRAM, else STOP RUN 
 */
void
gen_goback()
{
    if (module_flag) /* If is a module generate EXIT PROGRAM, else STOP RUN */
        gen_exit(1);
    else
        gen_stoprun();
}

/* ok nao achei nenhuma referencia para esta funcao
void mark_actives( int first, int last ) {
        int i;
        if (last<first) last=first;
        if (first<0 || first>36) first=0;
        if (last<0 || last>36) last=0;
        for (i=first;i<=last;i++) active[i]=1;
}

 ok
 used with qsort
 return:	strncmp from *z1 and *z2
 see man qsort for more explanation */
int
sort_exref_compare(const void *z1, const void *z2)
{
    char ss1[256], ss2[256];

    strncpy(ss1, var_name(*(struct sym **) z1), sizeof (ss1));
    strncpy(ss2, var_name(*(struct sym **) z2), sizeof (ss2));
    return strncmp(ss1, ss2, sizeof (ss1));
}

void
dump_symbols()
{
    int i, j, k, arsize, slen;
    struct sym *sy, *sy1, **sytable;
    char t, *s, *str1, sa1[256];

    if (!HTG_list_flag)
        return;

    fprintf(o_lst,
            "\n=======================================================================");
    fprintf(o_lst, "\n\nSymbols of module:%20.20s\n", pgm_label);
    fprintf(o_lst, "--------------------------------------\n");
    for (i = 0; i < HASHLEN; i++)
    {
        /*            for (sy=labtab[i];sy!=NULL;sy=sy->next) { */
        for (sy = vartab[i]; sy != NULL; sy = sy->next)
        {
            t = sy->type;
            sy1 = sy;
            while (sy1)
            {
                /* check if any variables (excluding intrinsic functions)
                   are undefined */
                if ((sy1->defined == 0) && (sy->type == 0))
                {
                    yyerror("Declared but undefined variable \'%s\' found.", sy1->name);
                    /*                             fprintf(stderr, "Undefined variable \'%s\', defined=%d, type=%c, line=%d;\n",
                                                   sy1->name, sy1->defined, sy1->type, sy1->xrefs.lineno[0]); */
                }
#if 0
                else
                {
                    fprintf(stderr, "Defined variable \'%s\', defined=%d, type=%c, line=%d;\n",
                            sy1->name, sy1->defined, sy1->type, sy1->xrefs.lineno[0]);
                }
#endif
                sy1 = sy1->clone;
            }
        }
    }

    if (!HTG_list_flag)
    {
        return;
    }


    /* Determine size of tree */
    for (i = 0, j = 0; i < HASHLEN; i++)
    {
        for (sy1 = vartab[i]; sy1 != NULL; sy1 = sy1->next)
        {
            for (sy = sy1; sy; sy = sy->clone)
            {
                if (sy->xrefs.lineno[0] != 0)
                {
                    j++;
                }
            }
        }
    }
    arsize = j;

    /* Allocate sort array  */
    sytable = (struct sym**) malloc(sizeof (struct sym *) * (arsize));

    /* Initialize sort array from hash tree */
    for (i = 0, j = 0; i < HASHLEN; i++)
    {
        for (sy1 = vartab[i]; sy1 != NULL; sy1 = sy1->next)
        {
            for (sy = sy1; sy; sy = sy->clone)
            {
                if (sy->xrefs.lineno[0] != 0)
                {
                    sytable[j] = sy;
                    str1 = var_name(sytable[j]);
                    j++;
                }
            }
        }
    }

    /* Sort array using the quick sort function */
    qsort(sytable, arsize, sizeof (struct sym *), sort_exref_compare);

    if (HTG_xref_flag)
    {

        fprintf(o_lst, "\n---------------------------------------------------- Cross Refrence Listing --------------------------------------------------------\n\n");
        fprintf(o_lst, "Variable Symbol ( Qualifiers )             Locations\n");
        fprintf(o_lst, "-----------------------------------------+------------------------------------------------------------------------------------------\n");
        for (i = 0; i < arsize; i++)
        {
            sy = sytable[i];
            if (sy->xrefs.lineno[0] != 0)
            {
                s = var_name(sy);

                strcpy(sa1, "");
                j = 0;
                k = 0;
                slen = strlen(s);
                if (slen > 40)
                {
                    for (j = 0; j < (slen - 40); j = j + k)
                    {
                        str1 = strstr(s + j, " OF ");
                        k = strlen(str1 + 4);
                        k = slen - j - k;
                        strncpy(sa1, s + j, k);
                        sa1[k] = '\0';
                        fprintf(o_lst, "%-40s\n", sa1);
                    }
                    strcpy(sa1, s + j);
                }
                else
                {
                    strcpy(sa1, s);
                }
                fprintf(o_lst, "%-40s ", sa1);

                for (j = 0; j < sy->xrefs.pos; j++)
                {
                    if ((j % 8 == 0) && (j > 0))
                    {
                        fprintf(o_lst, "\n%-40s ", "");
                    }
                    fprintf(o_lst, "%06d ", sy->xrefs.lineno[j]);
                }
                fprintf(o_lst, "\n");
            }
        }
    }

    if (!HTG_list_flag)
    {
        return;
    }

    fprintf(o_lst, "\n---------------------------------------------------------------+-----------------\n");
    fprintf(o_lst, "Symbol ( Variables )                    Type Level Len Dec Mul | Desc Loc  Pic  S\n");
    fprintf(o_lst, "---------------------------------------------------------------+-----------------\n");
    for (i = 0; i < arsize; i++)
    {
        sy = sytable[i];
        s = var_name(sy);

        strcpy(sa1, "");
        j = 0;
        k = 0;
        slen = strlen(s);
        if (slen > 40)
        {
            for (j = 0; j < (slen - 40); j = j + k)
            {
                str1 = strstr(s + j, " OF ");
                k = strlen(str1 + 4);
                k = slen - j - k;
                strncpy(sa1, s + j, k);
                sa1[k] = '\0';
                fprintf(o_lst, "%-40s\n", sa1);
            }
            strcpy(sa1, s + j);
        }
        else
        {
            strcpy(sa1, s);
        }

        fprintf(o_lst,
                "%-40s%4c%1c%3d %5d %3d %3d%c| %04X %04X%c%04X %1d\n",
                sa1,
                /*                        sy->type, */
                sy->type ? sy->type : '0',
                sy->flags.just_r ? 'R' : ' ',
                sy->level,
                sy->len,
                sy->decimals,
                sy->times,
                sy->occurs_flg ? '*' : ' ',
                sy->descriptor,
                sy->location,
                sy->linkage_flg ? '*' : ' ',
                sy->pic,
                sy->sec_no);
    }
    fprintf(o_lst, "\n\n");


    fprintf(o_lst, "\n-----------------------------------------------\n");
    fprintf(o_lst, "Symbol ( 88-condition )       Variable tested");
    fprintf(o_lst, "\n-----------------------------------------------\n");
    for (i = 0; i < HASHLEN; i++)
    {
        for (sy = vartab[i]; sy != NULL; sy = sy->next)
        {
            t = sy->type;
            if (t == '8')
                fprintf(o_lst, "%22.22s %22.22s\n",
                    sy->name,
                    sy->parent->name);
        }
    }

    fprintf(o_lst,
            "\n-----------------------------------------------------------------------\n");
    fprintf(o_lst, "%s%s%s",
            "                       Paragraph ",
            "                         Section ", " Type");
    fprintf(o_lst,
            "\n-----------------------------------------------------------------------\n");
    for (i = 0; i < HASHLEN; i++)
    {
        for (sy = labtab[i]; sy != NULL; sy = sy->next)
        {
            t = sy->type;
            sy1 = sy;
            while (sy1)
            {
                if ((sy1->type == 'P') || (sy1->type == 'S'))
                {
                    fprintf(o_lst, "%32.32s %32.32s    %c\n",
                            (sy1->type == 'P') ? sy1->name : "",
                            (sy1->type == 'S') ? sy1->name :
                            (sy1->parent ? sy1->parent->name : ""),
                            sy1->type);
                }
                sy1 = sy1->clone;
            }
        }
    }

    fprintf(o_lst, "\n\nTinyCOBOL compile audit summary:\n");
    fprintf(o_lst, "Total lines compiled           : %4d\n", source_lineno);
    fprintf(o_lst, "Total number of warnings       : %4d\n", wrncnt);
    fprintf(o_lst, "Total number of errors found   : %4d\n", errcnt);

}

/* ok
 search for "-" caracter in *s and replace it with _
 enter:	char *
 return:	void */
void
chg_underline(char *s)
{
    char *s1;
    s1 = s; /* walter */
    while (*s1)
    {
        if (*s1 == '-') *s1 = '_';
        s1++;
    }
    /*        while ((s1=strchr(s,'-'))!=NULL) *s1='_'; */
}

void
gen_enter_runelement(int type)
{
    /* this should be cleaned if we are going to load it */
    fprintf(o_src, "\tmovl\t$s_base%d+0, %%eax\n", pgm_segment);
    push_eax();
    push_immed(type);
    push_immed(program_name_literal->len);
    loadloc_to_eax((struct sym *) program_name_literal);
    push_eax();
    asm_call("tcob_enter_runelement");
}
/* end of HTCOBGEN.C */