/*
    Clif - A C-like Interpreter Framework
    Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997 T. Hruz, L. Koren
    1998, 1999, 2000 L. Koren

    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 of the License, 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 program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

*/

/*
 * comp_maint.c
 * 
 * all maintenance functions for compiler called from ys
 */

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <setjmp.h>

#include "global.h"		/* Header of global variables */
#include "define.h"		/* Clif's memory regions */
#include "control.h"		/* Header of fixative structures */
#include "type.h"		/* Header of internal representation
				   of types */
#include "struct.h"		/* Header of globally used structures */
#include "mystdio.h"		/* Redefining NULL */
#include "instr.h"		/* Header od structures. Defines size of
				   virtual machine instructions. */
#include "token.h"		/* Header of tokens */
#include "config.h"
#include "geninstr.h"		/* Header of macros. Defines instruction set
				   of the virtual machine. */
#include "comp_maint.h"		/* Declarations of functions and
				   variables from this file. */
#include "version.h"
#include "allocx.h"
#include "ys.h"
#include "run_str.h"
#include "ls.h"
#include "tables.h"
#include "input.h"
#include "printfx.h"
#include "s-conv.h"
#include "flags.h"
#include "virtual_machine.h"

/*
 * Prints file name in which an error occurs.
 */
static void print_file_name PROTO((void));

/* Prints source line in which an */
/* error occurs. */
static void print_source_line PROTO((void));

static void print_error_number PROTO((int));
static void print_line_number PROTO((int));
static char *type2string PROTO((struct internal_type *));

static void info PROTO((void));

/* Main compiler initialization. */
static int init PROTO((void));

/* Returns if it is possible to make */
/* implicit cast. */
static int hierarchy PROTO((int));

/* Checks if lvalue and expression are assignable in pointer
   arithmetic. */
static int pointer_cast PROTO((void));

/* Adding information about arrays to */
/* the list of pecifiers. */
static int add_subs_to_spec_list PROTO((struct internal_type **));

/* The value is one when the definition of function formal parameters
   are parsed. 
   The value is zero otherwise. */
static int func_def_f = 0;

static void mov2lvalue PROTO((struct internal_type *,
			      enum intern_arit_class));

/* Copy internal type. Used in function declaration or definition. */
static struct internal_type *
copy_type PROTO((struct internal_type *));

/* Compare if pointers to 2 types are comaptible. */
static int type_compare PROTO((struct internal_type *, struct
internal_type *));

/* Find cycles in pointer definitions and declarations. */ 
static struct internal_type *cyclic_def PROTO((struct internal_type *,
struct internal_type *));

/* Arrange all things for starting main */
static int start_main PROTO((void));

/* Source line number. Detecting if */
/* the current line was already */
/* printed. Using in error messages. */
int             source_line_number = 0;

/* Line number where the error was. */
int             error_line_number = 0;

/* Count of errors. */
int error_count;

/* Flag if warnings should be */
/* printed. Default no. */
int             warning_yes = 0;

/* Warn if a comment beginning is in comment. */
int warning_comment;

/* Warn if it is something wrong in scanf, printf etc. formats. */
int warning_format;

/* Don't print warning messages. */
int warning_inhibit;

/* Warn if functions or parameters are implicit defined. */
int warning_implicit;

/*  Nonzero means warn about function definitions that default the return type
   or that use a null return and have a return-type other than void.  */
int warning_return_type;

/* If set, warn about trigraphs. */
int warning_trigraphs;

/* Warn about unused locals. */
int warning_unused;

/* Warn if a variable is used before it is initialized. */
int warning_uninitialized;

/* Print various extra warnings. */
int warning_extra;

/* Warn if a function returns an aggregate. */
int warning_aggregate_return;

/* Warnings are errors. */
int warnings_are_errors;

/* Flag in the case of errors or */
/* compile only. Default compile and */
/* execute. */
int             no_compile_only = 1;

/* If nonzero compile everything and than call main function. Simulate
   compiler beahvior. */
int handle_main;

/* Nonzero means call by value should be used. Default. */
int call_by_value;

/* Nonzero means call by reference. */
int call_by_reference = 1;

/* If nonzero, generate additional debugging information. */
int dbg_symbols;

/* Type table of hierarchy. The size is determined by combination of
   all possible type specifiers. */
static int      pri[2 * LAST_AND_UNUSED_ARIT_CLASS];

struct internal_type 
*l_type_spec;
				/* List of type specifiers in function
                                   declaration. */
struct ident_list_str
*ident_list;
				/* List of formal parameters. */

FILEATTR pf, spf[100];		/* Max number of opened files is 100. */

FILE *cop;			/* cop is defined for producing
				 * virtual machine instruction file.
				 * If you want to use it compile with
				 * -DCODE */


#ifdef CODE
static char     file[] = "code";
#endif

int             bc = BC;	/* Defining of size of framework memory. */

#define EMAIL "koren@vm.stuba.sk"

/* Structures for finding duplicate */
/* labels in a switch statement. They */
/* are needed for the proper error */
/* message. */
static struct list_const1 *tmp_m, *tmp_c;

int scope_level = 0;
int verbose = 0;

char           *_clif_debug;	/* Special variable for debugging purposes.
				 * It is only used during execution of
				 * debugging (dbx) It is no used yet. */

jmp_buf jmpbuf;			/* Used in setjmp and longjmp. */
extern void fatal_handler_register PROTO((void));

/*
 * Gives a short info at the beginning of the Clif's session.
 */
static void
info ()
{
  fprintfx (stderr, "\t\t\tC-like Interpreter Framework Clif\n");
/*  fprintfx (stderr, "\t\t\tLanguage for Optimal Control Theory\n");*/
  fprintfx (stderr, "\t\t\tVersion %s\n", version);
  fprintfx (stderr, "\t\t\tFor help run with parameter -help\n");
  fprintfx (stderr, "\t\t\tCopyright (c) 1992 - 1998\n");
  fprintfx (stderr, "\t\t\tHruz Tomas and Koren Ludovit\n");
  fprintfx (stderr, "\t\t\tClif comes with ABSOLUTELY NO WARRANTY;\n");
  fprintfx (stderr, "\t\t\tfor details type clif -w .\n");
  fprintfx (stderr, "\t\t\tThis is free software, and you are welcome\n");
  fprintfx (stderr, "\t\t\tto redistribute it under certain conditions;\n");
  fprintfx (stderr, "\t\t\ttype clif -c for details.\n\n");
}

void
clif (argc, argv)		/* ------>> Main function. <<------ */
  int             argc;
  char           *argv[];
{

  /*
   * Parsing of the command-line arguments.
   */
  init_rs (argc, argv);
  if (-1 == yy_rs_parse ())
    return;
  if (verbose)
    {
      info ();
      printfx ("\nThis is interpreter Clif \n\n");
    }

  /*
   * Initialization of the Clif compiler.
   */
  if (0 == init ())
    return;
  if (-1 == init_input (++argc_counter, argvv))
    /* Initialization of the input. */
    return;

  if (1 == call_by_reference  &&
      1 == call_by_value)
    error_message (7002);

  fatal_handler_register ();

  /* If fatal errors occured, return. */
  if (setjmp (jmpbuf))
    return;

  /*
   * Parsing
   */
  yyparse ();

  if (handle_main && no_compile_only)
    {
      if (start_main ())
	return;
#ifndef NOT_MSWIN_AND_YES_DOS
      VIRTUAL_MACHINE_SUSPENDED_RESET;
#endif
      exec ();
    }
}


/*
 * char *say(spr)         Message saving (obsolete).
 */

/*
 * char *spr; { int i; char *a; char *callocx();
 * a=callocx(1,strlen(message)+1); return(strcpy(a,spr)); }
 */

/*
 * If break occurred it saves the backpatch address of the JMP instruction.
 */
int
brfix ()
{
  union fix      *fixp_arch;

  fixp_arch = fixp;		/* The current value of the fixative */
  /* pointer is stored for the next */
  /* usage. (If in the nested if break */
  /* is used.) */

  while (IF == fixp->if1.major)
    fixp--;

  if (fixp == (union fix *) fixst)
    {
      error_message (3000);
      fixp = fixp_arch;
      return (-1);
    }
  if (WHILE == fixp->while1.major)
    {
      struct break1  *bp;

      if (NULL == fixp->while1.bnext)
	{
#ifdef DEBUG
	  printfx ("break in while fixed\n");
#endif
	  fixp->while1.bnext = (struct break1 *) 
	    allocate (sizeof (struct break1), BLOCK);
	  fixp->while1.bnext->adr = kodp;
	  fixp->while1.bnext->next = NULL;
	}
      else
	{
	  bp = fixp->while1.bnext;
	  while (NULL != bp->next)
	    bp = bp->next;
#ifdef DEBUG
	  printfx ("break in while fixed\n");
#endif
	  bp->next = (struct break1 *) 
	    allocate (sizeof (struct break1), BLOCK);
	  bp->next->adr = kodp;
	  bp->next->next = NULL;
	}
    }
  if (FOR == fixp->for1.major)
    {
      struct break1  *bp;

      if (NULL == fixp->for1.bnext)
	{
#ifdef DEBUG
	  printfx ("break in for fixed\n");
#endif
	  fixp->for1.bnext = (struct break1 *) 
	    allocate (sizeof (struct break1), BLOCK);
	  fixp->for1.bnext->adr = kodp;
	  fixp->for1.bnext->next = NULL;
	}
      else
	{
	  bp = fixp->for1.bnext;
	  while (NULL != bp->next)
	    bp = bp->next;
#ifdef DEBUG
	  printfx ("break in for fixed\n");
#endif
	  bp->next = (struct break1 *) 
	    allocate (sizeof (struct break1), BLOCK);
	  bp->next->adr = kodp;
	  bp->next->next = NULL;
	}
    }
  if (SWITCH == fixp->switch1.major)
    {
      struct break1  *bp;

      if (NULL == fixp->switch1.bnext)
	{
#ifdef DEBUG
	  printfx ("break in switch fixed\n");
#endif
	  fixp->switch1.bnext = (struct break1 *) 
	    allocate (sizeof (struct break1), BLOCK);
	  fixp->switch1.bnext->adr = kodp;
	  fixp->switch1.bnext->next = NULL;
	}
      else
	{
	  bp = fixp->switch1.bnext;
	  while (NULL != bp->next)
	    bp = bp->next;
#ifdef DEBUG
	  printfx ("break in switch fixed\n");
#endif
	  bp->next = (struct break1 *) 
	    allocate (sizeof (struct break1), BLOCK);
	  bp->next->adr = kodp;
	  bp->next->next = NULL;
	}
    }
  fixp = fixp_arch;
  return (0);
}

/*
 * If continue occurred it saves the backpatch address of the JMP
 * instruction.
 */
int
cofix ()
{

  union fix      *fixp_arch;

  fixp_arch = fixp;

  while (IF == fixp->if1.major)
    fixp--;

  if (fixp == (union fix *) fixst)
    {
      error_message (3001);
      return (-1);
    }
  if (WHILE == fixp->while1.major)
    {
      struct cont1   *cp;

      if (NULL == fixp->while1.cnext)
	{
#ifdef DEBUG
	  printfx ("continue in while fixed\n");
#endif
	  fixp->while1.cnext = (struct cont1 *) 
	    allocate (sizeof (struct cont1), BLOCK);
	  fixp->while1.cnext->adr = kodp;
	  fixp->while1.cnext->next = NULL;
	}
      else
	{
	  cp = fixp->while1.cnext;
	  while (NULL != cp->next)
	    cp = cp->next;

#ifdef DEBUG
	  printfx ("continue in while fixed\n");
#endif
	  cp->next = (struct cont1 *) 
	    allocate (sizeof (struct cont1), BLOCK);
	  cp->next->adr = kodp;
	  cp->next->next = NULL;
	}
    }
  if (FOR == fixp->for1.major)
    {
      struct cont1   *cp;

      if (NULL == fixp->for1.cnext)
	{
#ifdef DEBUG
	  printfx ("continue in for fixed\n");
#endif
	  fixp->for1.cnext = (struct cont1 *) 
	    allocate (sizeof (struct cont1), BLOCK);
	  fixp->for1.cnext->adr = kodp;
	  fixp->for1.cnext->next = NULL;
	}
      else
	{
	  cp = fixp->for1.cnext;
	  while (NULL != cp->next)
	    cp = cp->next;
#ifdef DEBUG
	  printfx ("continue in for fixed\n");
#endif
	  cp->next = (struct cont1 *)
	    allocate (sizeof (struct cont1), BLOCK);
	  cp->next->adr = kodp;
	  cp->next->next = NULL;
	}
    }
  fixp = fixp_arch;
  return (0);
}

/*
 * If return occurred it saves the backpatch address of the JMP instruction.
 */
void
retfix ()
{
  struct return1 *arch, *arch1;

  arch = rp;

  if (NULL == rp)
    {
#ifdef DEBUG
      printfx ("return fixed\n");
#endif
      rp = (struct return1 *)
	allocate (sizeof (struct return1), BLOCK);
      rp->adr = kodp;
      rp->next = NULL;
    }
  else
    {
      while (NULL != rp)
	{
	  arch1 = rp;
	  rp = rp->next;
	}
#ifdef DEBUG
      printfx ("return fixed\n");
#endif
      rp = (struct return1 *)
	allocate (sizeof (struct return1), BLOCK);
      rp->adr = kodp;
      arch1->next = rp;
      rp->next = NULL;
      rp = arch;
    }
}

/*
 * Backpatches the address of continue in while loop.
 */
void
fix_cont_w ()
{
  while (NULL != fixp->while1.cnext)
    {
#if 0
      struct cont1   *tmp = fixp->while1.cnext;
#endif

      ((struct OPERAND_1_ma *) (fixp->while1.cnext->adr))->adr =
	fixp->while1.jmp;
      fixp->while1.cnext = fixp->while1.cnext->next;
#if 0
      free (tmp);
#endif
    }
}

/*
 * Backpatches the address of continue in for loop.
 */
void
fix_cont_f ()
{
  while (NULL != fixp->for1.cnext)
    {
#if 0
      struct cont1   *tmp = fixp->for1.cnext;
#endif

      ((struct OPERAND_1_ma *) (fixp->for1.cnext->adr))->adr =
	fixp->for1.jmp3;
      fixp->for1.cnext = fixp->for1.cnext->next;
#if 0
      free (tmp);
#endif
    }
}

/*
 * Backpatches the address of break in while loop.
 */
void
fix_break_w ()
{

  while (NULL != fixp->while1.bnext)
    {
#if 0
      struct break1  *tmp = fixp->while1.bnext;
#endif

      ((struct OPERAND_1_ma *) (fixp->while1.bnext->adr))->adr = kodp;
      fixp->while1.bnext = fixp->while1.bnext->next;
#if 0
      free (tmp);
#endif
#ifdef DEBUG
      printfx ("JMP fixed =%u\n", kodp);
#endif
    }
}

/*
 * Backpatches the address of break in for loop.
 */
void
fix_break_f ()
{
  while (NULL != fixp->for1.bnext)
    {
#if 0
      struct break1  *tmp = fixp->for1.bnext;
#endif

      ((struct OPERAND_1_ma *) (fixp->for1.bnext->adr))->adr = kodp;
      fixp->for1.bnext = fixp->for1.bnext->next;
#if 0
      free (tmp);
#endif
    }
}

/*
 * Backpatches the address of a return statement.
 */
void
fix_ret ()
{
  if (NULL == rp && ! VOID_P(type_com[set]->output))
    {
      error_message (6028);
      return;
    }
  
  while (NULL != rp)
    {
      ((struct OPERAND_1_ma *) (rp->adr))->adr = kodp;
      rp = rp->next;
#if 0
      free (tmp);
#endif
    }
}

/*
 * Backpatches the address of break in for loop.
 */
void
fix_break_s ()
{
  while (NULL != fixp->switch1.bnext)
    {
#if 0
      struct break1  *tmp = fixp->switch1.bnext;
#endif

      ((struct OPERAND_1_ma *) (fixp->switch1.bnext->adr))->adr = kodp;
      fixp->switch1.bnext = fixp->switch1.bnext->next;
#if 0
      free (tmp);
#endif
    }
}

/*
 * Initialization of framework environment.
 */
static int
init ()
{
  mem_start = (char *) callocx (bc * SIZE_SPACE, PAGE);
  if (NULL == mem_start)
    {
      error_message (4000);
      return (0);
    }
  stack = mem_start + bc * SIZE_SPACE * PAGE;
  bp = stack;
  frame = stack;
  pc = mem_start;
  kodp = mem_start;
  kodp1 = kodp;
  kodp2 = kodp;
  current_instr = kodp;
#ifdef DEBUG
  printfx ("Memory allocated\n\n");
#endif

  if (!hastab_init ())
    return 0;
  if (!identtab_init ())
    return 0;
  
  hastab_remote = (struct remote_has_tab *)
    callocx (SIZE_REMOTE, sizeof (struct remote_has_tab));
  if (NULL == hastab_remote)
    {
      error_message (4000);
      return (0);
    }
#ifdef DEBUG
  printfx ("Hash table for remote procedures allocated\n\n");
#endif
  ast = (char **) callocx (bc * SIZE_ARIT_STACK, PAGE * sizeof (char *));
  if (NULL == ast)
    {
      error_message (4000);
      return (0);
    }
  ast += bc * SIZE_ARIT_STACK * PAGE;
#ifdef DEBUG
  printfx ("Arithmetic stack allocated \n\n");
#endif
  tmp = (char *) callocx (bc * SIZE_TMP_STACK, PAGE);
  if (NULL == tmp)
    {
      error_message (4000);
      return (0);
    }
  tmp += bc * SIZE_TMP_STACK * PAGE;
  tmp_start = tmp;
  tmph = tmp;
#ifdef DEBUG
  printfx ("Temporary stack allocated \n\n");
#endif
  pri[VID] = 12;
  pri[CHR] = pri[SIGNED_AC | CHR] = 11;
  pri[UNSIGNED_AC | CHR] = 10;
  pri[SHORT_AC | INTEGER] = pri[SHORT_AC | SIGNED_AC | INTEGER] = 9;
  pri[SHORT_AC | UNSIGNED_AC | INTEGER] = 8;
  pri[INTEGER] = pri[SIGNED_AC | INTEGER] = 7;
  pri[UNSIGNED_AC | INTEGER] = 6;
  pri[LONG_AC | INTEGER] = pri[LONG_AC | SIGNED_AC | INTEGER] = 5;
  pri[LONG_AC | UNSIGNED_AC | INTEGER] = 4;
  pri[FLT] = 3;
  pri[DOUB] = 2;
  pri[LONG_AC | DOUB] = 1;
#ifdef DEBUG
  printfx ("Priority table defined\n\n");
#endif
  dim[0] = -1;
  fixst = callocx (SIZE_STRUCT_FIX, sizeof (union fix));
  if (NULL == fixst)
    {
      error_message (4000);
      return (0);
    }
  fixp = (union fix *) fixst;
#ifdef DEBUG
  printfx ("Fix stack allocated\n\n");
  printfx ("BEGIN\n\n");
#endif

  if (!hastab_goto_init ())
    return (0);
  
#ifdef CODE
  cop = fopen (file, "w");
  if (NULL == cop)
    {
      perror ("");
      spf[s].name = file;
      error_message (7001);
      return (0);
    }
  fprintfx (cop, "\n\nIn this file is stored generated code:\n");
  fclose (cop);
  cop = fopen (file, "a");
  if (NULL == cop)
    {
      perror ("");
      spf[s].name = file;
      error_message (7001);
      return (0);
    }
#endif
  return (1);
}


/*
 * Yacc internal error message function.
 */
/* It has to have an parameter for the */
/* sake of internal usage in yyparse */
/* (yacc). */
int
yyerror (s)
  char           *s;
{
#if DEBUG
  fprintfx (stderr, "%s\n", s);
#endif
  return (0);
}

/*
 * Type table of hierarchy.
 */
static int
hierarchy (t)
  int             t;
{
  return (pri[t]);
}

/*
 * Process implicit cast in expressions.
 */
int
implicit_cast ()
{
  if (type_com[set]->attribute.type_qualifier 
      != type_com[set - 1]->attribute.type_qualifier)
    {
      switch (type_com[set - 1]->attribute.type_qualifier)
	{
	case CONST:
	  type_com[set - 1] = type_com[set];
	  break;
	default:
	  break;
	}
    }
  if (hierarchy (type_ac[set]) < hierarchy (type_ac[set - 1]))
    {
      switch (type_ac[set])
	{
	case LONG_AC | DOUB:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILDb;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUILDb;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLILDb;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILDb;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUILDb;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILDb;
	      break;
	    case DOUB:
	      GEN_CVTDLDb;
	      break;
	    case FLT:
	      GEN_CVTFLDb;
	      break;
	    case CHR:
	      GEN_CVTCLDb;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLDb;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLDb;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  type_ac[set - 1] = LONG_AC | DOUB;
	  GENCODE;
	  return 1;
	case DOUB:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIDb;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIDb;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIDb;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIDb;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIDb;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIDb;
	      break;
	    case FLT:
	      GEN_CVTFDb;
	      break;
	    case CHR:
	      GEN_CVTCDb;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCDb;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCDb;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  type_ac[set - 1] = DOUB;
	  GENCODE;
	  return 1;
	case FLT:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIFb;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIFb;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIFb;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIFb;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIFb;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIFb;
	      break;
	    case CHR:
	      GEN_CVTCFb;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCFb;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCFb;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  type_ac[set - 1] = FLT;
	  GENCODE;
	  return 1;
	case LONG_AC | UNSIGNED_AC | INTEGER:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILUIb;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUILUIb;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLILUIb;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILUIb;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILUIb;
	      break;
	    case CHR:
	      GEN_CVTCLUIb;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLUIb;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLUIb;
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  type_ac[set - 1] = LONG_AC | UNSIGNED_AC | INTEGER;
	  GENCODE;
	  return 1;
	case LONG_AC | INTEGER:
	case LONG_AC | SIGNED_AC | INTEGER:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILIb;
	      break;
	    case UNSIGNED_AC | INTEGER:
				/* If one operand has type long int
				   and the other operand has type
				   unsigned int, if a long int can
				   represent all values of an unsigned
				   int, the operand of type unsigned
				   int is converted to long int; if a
				   long int cannot represent all the
				   values of an unsigned int, both
				   operands are converted to unsigned
				   long int. */
#ifdef LONG_CAN_UINT
	      GEN_CVTUILIb;
#else
	      GEN_CVTUILUIb;
#endif
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILIb;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILIb;
	      break;
	    case CHR:
	      GEN_CVTCLIb;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLIb;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLIb;
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  type_ac[set - 1] = LONG_AC | INTEGER;
	  GENCODE;
	  return 1;
	case UNSIGNED_AC | INTEGER:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIUIb;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIUIb;
	      break;
	    case CHR:
	      GEN_CVTCUIb;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCUIb;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCUIb;
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  type_ac[set - 1] = UNSIGNED_AC | INTEGER;
	  GENCODE;
	  return 1;
	case INTEGER:
	case SIGNED_AC | INTEGER:
	  switch (type_ac[set - 1])
	    {
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIIb;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIIb;
	      break;
	    case CHR:
	      GEN_CVTCIb;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCIb;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCIb;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  type_ac[set - 1] = INTEGER;
	  GENCODE;
	  return 1;
	case SHORT_AC | INTEGER:
	case SHORT_AC | SIGNED_AC | INTEGER:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTSIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTSIUIt;
	      type_ac[set] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILIt;
	      type_ac[set] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSILUIt;
	      type_ac[set] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSUIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTSIDt;
	      type_ac[set] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTSILDt;
	      type_ac[set] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTSIFt;
	      type_ac[set] = FLT;
	      break;
	    case CHR:
	      GEN_CVTSIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTSIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTUCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case SHORT_AC | UNSIGNED_AC | INTEGER:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTSUIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIUIt;
	      type_ac[set] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSUILIt;
	      type_ac[set] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSUIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILUIt;
	      type_ac[set] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSUIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTSUIDt;
	      type_ac[set] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTSUILDt;
	      type_ac[set] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTSUIFt;
	      type_ac[set] = FLT;
	      break;
	    case CHR:
	      GEN_CVTSUIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTSUIIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTUCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case CHR:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTCUIt;
	      type_ac[set] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTCLIt;
	      type_ac[set] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTCLUIt;
	      type_ac[set] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSUIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTCDt;
	      type_ac[set] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTCLDt;
	      type_ac[set] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTCFt;
	      type_ac[set] = FLT;
	      break;
	    case CHR:
	      GEN_CVTCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTUCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case SIGNED_AC | CHR:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTSCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTSCUIt;
	      type_ac[set] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSCLIt;
	      type_ac[set] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSCLUIt;
	      type_ac[set] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSUIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTSCDt;
	      type_ac[set] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTSCLDt;
	      type_ac[set] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTSCFt;
	      type_ac[set] = FLT;
	      break;
	    case CHR:
	      GEN_CVTSCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTSCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTUCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case UNSIGNED_AC | CHR:
	  switch (type_ac[set - 1])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTUCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUCUIt;
	      type_ac[set] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTUCLIt;
	      type_ac[set] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTUCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTUCLUIt;
	      type_ac[set] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTUCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSUIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTUCDt;
	      type_ac[set] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTUCLDt;
	      type_ac[set] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTUCFt;
	      type_ac[set] = FLT;
	      break;
	    case CHR:
	      GEN_CVTUCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTUCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTSCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCIt; GENCODE;
	      type_ac[set] = INTEGER;
	      GEN_CVTUCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	default:
	  fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	  error_message (5000);
	  abort ();
	}
    } 
  else if (hierarchy (type_ac[set]) > hierarchy (type_ac[set - 1]))
    {
      switch (type_ac[set - 1])
	{
	case LONG_AC | DOUB:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILDt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUILDt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLILDt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILDt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUILDt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILDt;
	      break;
	    case DOUB:
	      GEN_CVTDLDt;
	      break;
	    case FLT:
	      GEN_CVTFLDt;
	      break;
	    case CHR:
	      GEN_CVTCLDt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLDt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLDt;
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case DOUB:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIDt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIDt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIDt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIDt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIDt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIDt;
	      break;
	    case FLT:
	      GEN_CVTFDt;
	      break;
	    case CHR:
	      GEN_CVTCDt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCDt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCDt;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return (1);
	case FLT:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIFt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIFt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIFt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIFt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIFt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIFt;
	      break;
	    case CHR:
	      GEN_CVTCFt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCFt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCFt;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case LONG_AC | UNSIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILUIt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUILUIt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLILUIt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILUIt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILUIt;
	      break;
	    case CHR:
	      GEN_CVTCLUIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLUIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLUIt;
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case LONG_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILIt;
	      break;
	    case UNSIGNED_AC | INTEGER:
				/* If one operand has type long int
				   and the other operand has type
				   unsigned int, if a long int can
				   represent all values of an unsigned
				   int, the operand of type unsigned
				   int is converted to long int; if a
				   long int cannot represent all the
				   values of an unsigned int, both
				   operands are converted to unsigned
				   long int. */
#ifdef LONG_CAN_UINT
	      GEN_CVTUILIt;
#else
	      GEN_CVTUILUIt;
#endif
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILIt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILIt;
	      break;
	    case CHR:
	      GEN_CVTCLIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLIt;
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case UNSIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIUIt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIUIt;
	      break;
	    case CHR:
	      GEN_CVTCUIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCUIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCUIt;
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case INTEGER:
	  switch (type_ac[set])
	    {
	    case CHR:
	      GEN_CVTCIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCIt;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return (1);
	case SHORT_AC | INTEGER:
	case SHORT_AC | SIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTSIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTSIUIb;
	      type_ac[set - 1] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILIb;
	      type_ac[set - 1] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSILUIb;
	      type_ac[set - 1] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSUIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTSIDb;
	      type_ac[set - 1] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTSILDb;
	      type_ac[set - 1] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTSIFb;
	      type_ac[set - 1] = FLT;
	      break;
	    case CHR:
	      GEN_CVTSIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTSIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTUCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case SHORT_AC | UNSIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTSUIIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIUIb;
	      type_ac[set - 1] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSUILIb;
	      type_ac[set - 1] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSUIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILUIb;
	      type_ac[set - 1] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSUIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTSUIDb;
	      type_ac[set - 1] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTSUILDb;
	      type_ac[set - 1] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTSUIFb;
	      type_ac[set - 1] = FLT;
	      break;
	    case CHR:
	      GEN_CVTSUIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTSUIIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTUCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case CHR:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTCUIb;
	      type_ac[set - 1] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTCLIb;
	      type_ac[set - 1] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTCLUIb;
	      type_ac[set - 1] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSUIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTCDb;
	      type_ac[set - 1] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTCLDb;
	      type_ac[set - 1] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTCFb;
	      type_ac[set - 1] = FLT;
	      break;
	    case CHR:
	      GEN_CVTCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTUCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case SIGNED_AC | CHR:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTSCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTSCUIb;
	      type_ac[set - 1] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSCLIb;
	      type_ac[set - 1] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSCLUIb;
	      type_ac[set - 1] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSUIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTSCDb;
	      type_ac[set - 1] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTSCLDb;
	      type_ac[set - 1] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTSCFb;
	      type_ac[set - 1] = FLT;
	      break;
	    case CHR:
	      GEN_CVTSCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTSCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTUCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case UNSIGNED_AC | CHR:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTUCIb;
	      type_ac[set - 1] = INTEGER;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUCUIb;
	      type_ac[set - 1] = UNSIGNED_AC | INTEGER;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTUCLIb;
	      type_ac[set - 1] = LONG_AC | INTEGER;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTUCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTUCLUIb;
	      type_ac[set - 1] = LONG_AC | UNSIGNED_AC | INTEGER;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTUCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSUIIt;
	      type_ac[set] = INTEGER;
	      break;
	    case DOUB:
	      GEN_CVTUCDb;
	      type_ac[set - 1] = DOUB;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTUCLDb;
	      type_ac[set - 1] = LONG_AC | DOUB;
	      break;
	    case FLT:
	      GEN_CVTUCFb;
	      type_ac[set - 1] = FLT;
	      break;
	    case CHR:
	      GEN_CVTUCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTUCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTSCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCIb; GENCODE;
	      type_ac[set - 1] = INTEGER;
	      GEN_CVTUCIt;
	      type_ac[set] = INTEGER;
	      break;
	    case VID:
	      error_message (1009);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	default:
	  fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	  error_message (5000);
	  abort ();
	}
    } 
  else
    {
      if (CHR == type_ac[set])
	{
	  GEN_CVTCIt; GENCODE;
	  GEN_CVTCIb; GENCODE;
	  type_ac[set] = type_ac[set - 1] = INTEGER;
	}
      else if ((SIGNED_AC | CHR) == type_ac[set])
	{
	  GEN_CVTSCIt; GENCODE;
	  GEN_CVTSCIb; GENCODE;
	  type_ac[set] = type_ac[set - 1] = INTEGER;
	}
      else if ((UNSIGNED_AC | CHR) == type_ac[set])
	{
	  GEN_CVTUCIt; GENCODE;
	  GEN_CVTUCIb; GENCODE;
	  type_ac[set] = type_ac[set - 1] = INTEGER;
	}
      else if ((SHORT_AC | INTEGER) == type_ac[set] ||
	       (SHORT_AC | SIGNED_AC | INTEGER) == type_ac[set])
	{
	  GEN_CVTSIIt; GENCODE;
	  GEN_CVTSIIb; GENCODE;
	  type_ac[set] = type_ac[set - 1] = INTEGER;
	}
      else if ((SHORT_AC | UNSIGNED_AC | INTEGER) == type_ac[set])
	{
#ifdef SHORT_EQ_INT
	  GEN_CVTSUIUIt; GENCODE;
	  GEN_CVTSUIUIb; GENCODE;
	  type_ac[set] = type_ac[set - 1] = UNSIGNED_AC | INTEGER;
#else
	  GEN_CVTSUIIt; GENCODE;
	  GEN_CVTSUIIb; GENCODE;
	  type_ac[set] = type_ac[set - 1] = INTEGER;
#endif
	}
      return 1;
    }
}

/*
 * Process cast to l_value of an expresion.
 */
int
l_value_cast ()
{
  if (pointer_cast ())
    return 1;

  if (CONST_P(type_com[set]) && CHAR_P(type_com[set - 1]))
    {
#ifdef UCHAR_MAX
      if (INTEGER_P(type_com[set]) &&
	  *(int *)type_com[set]->attribute.domain > UCHAR_MAX)
      error_message (6026);
#endif
    }
  
  if (hierarchy (type_ac[set]) != hierarchy (type_ac[set - 1]))
    {
      switch (type_ac[set - 1])
	{
	case INTEGER:
	case SIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUII;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLII;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIIt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUII;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIIt;
	      break;
	    case DOUB:
	      GEN_CVTDI;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDI;
	      break;
	    case FLT:
	      GEN_CVTFI;
	      break;
	    case CHR:
	      GEN_CVTCIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCIt;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case UNSIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIUIt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIUI;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIUIt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIUI;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIUIt;
	      break;
	    case DOUB:
	      GEN_CVTDUI;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDUI;
	      break;
	    case FLT:
	      GEN_CVTFUI;
	      break;
	    case CHR:
	      GEN_CVTCUIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCUIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCUIt;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case LONG_AC | INTEGER:
	case LONG_AC | SIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILIt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUILIt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILIt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUILI;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILIt;
	      break;
	    case DOUB:
	      GEN_CVTDLI;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDLI;
	      break;
	    case FLT:
	      GEN_CVTFLI;
	      break;
	    case CHR:
	      GEN_CVTCLIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLIt;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case SHORT_AC | INTEGER:
	case SHORT_AC | SIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTISI;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUISI;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLISI;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUISI;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUISI;
	      break;
	    case DOUB:
	      GEN_CVTDSI;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDSI;
	      break;
	    case FLT:
	      GEN_CVTFSI;
	      break;
	    case CHR:
	      GEN_CVTCSI;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCSI;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCSI;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case LONG_AC | UNSIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILUIt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUILUIt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILUIt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLILUIt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILUIt;
	      break;
	    case DOUB:
	      GEN_CVTDLUI;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDLUI;
	      break;
	    case FLT:
	      GEN_CVTFLUI;
	      break;
	    case CHR:
	      GEN_CVTCLUIt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLUIt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLUIt;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case SHORT_AC | UNSIGNED_AC | INTEGER:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTISUI;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUISUI;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSISUI;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLISUI;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUISUI;
	      break;
	    case DOUB:
	      GEN_CVTDSUI;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDSUI;
	      break;
	    case FLT:
	      GEN_CVTFSUI;
	      break;
	    case CHR:
	      GEN_CVTCSUI;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCSUI;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCSUI;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case DOUB:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIDt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIDt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIDt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIDt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIDt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIDt;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDD;
	      break;
	    case FLT:
	      GEN_CVTFDt;
	      break;
	    case CHR:
	      GEN_CVTCDt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCDt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCDt;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case LONG_AC | DOUB:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTILDt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUILDt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLILDt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSILDt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUILDt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUILDt;
	      break;
	    case DOUB:
	      GEN_CVTDLDt;
	      break;
	    case FLT:
	      GEN_CVTFLDt;
	      break;
	    case CHR:
	      GEN_CVTCLDt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCLDt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCLDt;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case FLT:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIFt;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIFt;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIFt;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIFt;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIFt;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIFt;
	      break;
	    case DOUB:
	      GEN_CVTDF;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDF;
	      break;
	    case CHR:
	      GEN_CVTCFt;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCFt;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCFt;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case CHR:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIC;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIC;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIC;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIC;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIC;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIC;
	      break;
	    case DOUB:
	      GEN_CVTDC;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDC;
	      break;
	    case FLT:
	      GEN_CVTFC;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCC;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCC;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case SIGNED_AC | CHR:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTISC;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUISC;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLISC;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSISC;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUISC;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUISC;
	      break;
	    case DOUB:
	      GEN_CVTDSC;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDSC;
	      break;
	    case FLT:
	      GEN_CVTFSC;
	      break;
	    case CHR:
	      GEN_CVTCSC;
	      break;
	    case UNSIGNED_AC | CHR:
	      GEN_CVTUCSC;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case UNSIGNED_AC | CHR:
	  switch (type_ac[set])
	    {
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      GEN_CVTIUC;
	      break;
	    case UNSIGNED_AC | INTEGER:
	      GEN_CVTUIUC;
	      break;
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      GEN_CVTLIUC;
	      break;
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      GEN_CVTSIUC;
	      break;
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTLUIUC;
	      break;
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      GEN_CVTSUIUC;
	      break;
	    case DOUB:
	      GEN_CVTDUC;
	      break;
	    case LONG_AC | DOUB:
	      GEN_CVTLDUC;
	      break;
	    case FLT:
	      GEN_CVTFUC;
	      break;
	    case CHR:
	      GEN_CVTCUC;
	      break;
	    case SIGNED_AC | CHR:
	      GEN_CVTSCUC;
	      break;
	    case VID:
	      error_message (1010);
	      break;
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  GENCODE;
	  return 1;
	case VID:
	  fprintfx (stderr, "void conversion not supported yet\n");
	  return 1;
	default:
	  fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	  error_message (5000);
	  abort ();
	}
    }
  else
    return 1;
}


/* Checks if lvalue and expression are assignable in pointer
   arithmetic. */
static int
pointer_cast ()
{
  struct internal_type *lval_type = type_com[set - 1],
    *rval_type = type_com[set];

  if (LOCAL_P(lval_type) || REMOTE_P(lval_type))
    lval_type = lval_type->output;
  if (LOCAL_P(rval_type) || REMOTE_P(rval_type))
    rval_type = rval_type->output;
  
  if (POINTER_P(lval_type) &&
      (POINTER_P(rval_type) || ARRAY_P(rval_type)))
    {
      if (type_compare (rval_type, lval_type))
	error_message (6013);
    }
  else if (POINTER_P(lval_type) &&
	   (STRUCT_P(rval_type) || UNION_P(rval_type)))
    error_message (1028);
  else if (POINTER_P(rval_type))
    error_message (6012);
  else if (POINTER_P(lval_type))
    error_message (6012);
#if 0
  else if (ARRAY_P(lval_type))
    error_message (1028);
#endif
  else if ((STRUCT_P(lval_type) && STRUCT_P(rval_type)) ||
	   (UNION_P(lval_type) && UNION_P(rval_type)))
    {
      if (lval_type != rval_type)
	error_message (1028);
      else
	return 0;
    }
  else if ((STRUCT_P(rval_type) && !STRUCT_P(lval_type)) ||
	   (!STRUCT_P(rval_type) && STRUCT_P(lval_type)) ||
	   (UNION_P(rval_type) && !UNION_P(lval_type)) ||
	   (!UNION_P(rval_type) && UNION_P(lval_type)))
    error_message (1028);
  else
    return 0;
  return 1;
}


/*
 * Map function for array subscripts.
 */
void
array_subscript (pom)
  struct internal_type *pom;
{
  dim[++poc] = ((struct range *) pom->attribute.domain)->upper;
  pom = pom->arity;
  while (NULL != pom)
    {
      dim[++poc] = ((struct range *) pom->attribute.domain)->upper;
      pom = pom->arity;
    }
}

/*
 * Saves dimensions of arrays in the hash table.
 */
void
put_array_subscript (identtab_type)
  struct internal_type **identtab_type;
{
  /* During initialization an array may be without dimensions. */
  if (! poc)
    return;
  
  (*identtab_type)->input = (struct internal_type *)
    allocate (sizeof (struct internal_type), PERM);
  (*identtab_type)->input->attribute.arit_class = INTEGER;

  (*identtab_type)->input->attribute.domain =
    (char *) allocate (sizeof (struct range), PERM);
  ((struct range *) (*identtab_type)->input->attribute.domain)->lower = 0;
  ((struct range *) (*identtab_type)->input->attribute.domain)->upper = dim[poc];
  dim[poc--] = -1;
  if (-1 != dim[poc])
    {
      struct internal_type *pom;
      
      pom = (struct internal_type *) 
	allocate (sizeof (struct internal_type), PERM);
      pom->attribute.arit_class = INTEGER;
      pom->attribute.domain = 
	(char *) allocate (sizeof (struct range), PERM);
      ((struct range *) pom->attribute.domain)->lower = 0;
      ((struct range *) pom->attribute.domain)->upper = dim[poc];
      dim[poc--] = -1;
      (*identtab_type)->input->arity = pom;

      /* -1 means not an subscript anymore.
	 -2 means not defined subscript
	 (e.g. a[][1] (the flag is
	 NOT_DEFINED)). */
      while (-1 != dim[poc])
	{
	  pom->arity = (struct internal_type *) 
	    allocate (sizeof (struct internal_type), PERM);
	  pom->arity->attribute.arit_class = INTEGER;
	  pom->arity->attribute.domain = (char *)
	    allocate (sizeof (struct range), PERM);
	  pom = pom->arity;
	  ((struct range *) pom->attribute.domain)->lower = 0;
	  ((struct range *) pom->attribute.domain)->upper = dim[poc];
	  dim[poc--] = -1;
	}
    }
}


#define ERR_NO_INFO print_error_number (err_no);

#define ERROR_INFO print_file_name (); ERR_NO_INFO

#define ERROR_FULL_INFO(line_no) print_file_name (); \
print_line_number (line_no); \
print_error_number (err_no);


/*
 * Prints compiling and run-time error messages.
 */
void
error_message VPROTO((int err_no, ...))
{
#ifndef __STDC__
  int err_no;
#endif
  static int last_error_line;
  va_list point;

  VA_START (point, err_no);

#ifndef __STDC__
  err_no = va_arg (point, int);
#endif

  if (warning_inhibit && err_no >= 6000 && err_no < 7000)
    goto end;
  if (err_no < 6000 || err_no >= 7000)
    {
      error_count++;
      last_error_line = spf[s].line_counter;
    }
  else if (warnings_are_errors)
    error_count++;

  /* Do not print warnings, when error was printed on the same line. */
  if (last_error_line == spf[s].line_counter && err_no >= 6000 &&
      err_no < 7000)
    goto end;
  
  switch (err_no)
    {
      /* \verbatim{comp_maint_c_errors_1.tex} */

    case 1000:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"variable `%s' isn't declared\n", 
		text);
      break;
    case 1001:
      ERROR_FULL_INFO(spf[s].line_counter);
#ifdef OLD_SYNTAX
      fprintfx (stderr,
		"variable `%s' was already declared\n", 
		text);
#else
      fprintfx (stderr,
		"`%s' redeclared as different kind of symbol\n",
		text);
      
      ERROR_FULL_INFO(get_declaration_line (text));
      fprintfx (stderr, "previous declaration of `%s'\n", text);
#endif
      break;
    case 1002:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"remote procedure %s is not declared\n", 
		proc_name_text[proc]);
      break;
    case 1003:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"local variable `%s' was already declared\n", 
		text);
      break;
    case 1004:
#ifdef OLD_SYNTAX_ERROR
      print_source_line ();
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"at the %d-th char, near the `%s'\n",
		char_counter, yytext);
#else
      {
	char *text = va_arg(point, char *);
	ERROR_FULL_INFO(spf[s].line_counter);
	fprintfx (stderr,
		  "parse error before `%s'\n", text);
      }
#endif
      break;
    case 1005:
      print_source_line ();
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid type of the operand, %d-th character\n",
		char_counter);
      break;
    case 1006:
      ERROR_INFO;
      fprintfx (stderr,
		"remote function `%s' already declared\n",
		text);
      break;
    case 1007:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"remote function isn't declared\n");
      break;
    case 1008:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"remote functions are not in the load table\n");
      break;
    case 1009:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"`void' type in expression\n");
      break;
    case 1010:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"`void' type assigned to l_value\n");
      break;
    case 1011:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"load can't open file `%s'\n",
		yytext);
      break;
    case 1012:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"variable or field `%s' declared void\n",
		text);
      break;
    case 1013:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"switch quantity not an integer\n");
      break;
    case 1014:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"case label does not reduce to an integer constant\n");
      break;
    case 1015:
      ERROR_FULL_INFO(tmp_c->line_number);
      fprintfx (stderr,
		"duplicate case value\n");
      ERROR_FULL_INFO(tmp_m->line_number);
      fprintfx (stderr,
		"this is the first entry for that value\n");
      break;
    case 1016:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"case label not within a switch statement\n");
      break;
    case 1017:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"redefinition of `struct %s'\n", 
		text);
      break;
    case 1018:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"redefinition of `union %s'\n", 
		text);
      break;
    case 1019:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"redefinition of `enum %s'\n", 
		text);
      break;
    case 1020:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"conversion to non-scalar type requested\n");
      break;
    case 1021:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid type argument of `->'\n");
      break;
    case 1022:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid lvalue in unary `&'\n");
      break;
    case 1023:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"storage size of `%s' isn't known\n",
		text);
      break;
    case 1024:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"parameter `%s' has incomplete type\n",
		text);
      break;
    case 1025:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "field `%s' has incomplete type\n", text);
      break;
    case 1026:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"`%s' defined as wrong kind of tag\n", 
		text);
      break;
      
    case 1027:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"sizeof applied to an incomplete type\n");
      break;
    case 1028:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"incompatible types in assignment\n");
      break;
    case 1029:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid type argument of `unary *'\n");
      break;
    case 1030:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"wrong type argument to bit-complement\n");
      break;
    case 1031:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"wrong type argument to unary minus\n");
      break;
    case 1032:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"wrong type argument to unary plus\n");
      break;
    case 1033:
    {
      char *arg = va_arg (point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid operands to binary %s\n", arg);
    }
    break;
    case 1034:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid lvalue in assignment\n");
      break;
    case 1035:
    {
      char *arg = va_arg (point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid lvalue in %s\n", arg);
    }
    break;
    case 1036:
    {
      char *arg = va_arg (point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "function definition declared `%s'\n", arg);
    }
    break;
    case 1037:
    {
      char *arg = va_arg (point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "typedef `%s' is initialized\n", arg);
    }
    break;
    case 1038:
    {
      char *arg = va_arg (point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "`%s' undeclared here (not in a function)\n",
		arg);
    }
    break;
    case 1039:
    {
      char *arg = va_arg (point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "parse error before %s constant\n", arg);
    }
    break;
    case 1040:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "invalid initializer\n");
      break;
    
      /* \verbatim */
      /* \verbatim{comp_maint_c_errors_2.tex} */
    case 2000:
      ERROR_FULL_INFO(spf[s].line_counter);
#ifdef OLD_SYNTAX
      fprintfx (stderr,
		"`%s' is not an array variable\n",
		text);
#else
      fprintfx (stderr,
		"subscripted value is neither array nor pointer\n");
#endif
      break;
    case 2002:
      print_source_line ();
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"invalid type of array subscript\n");
      break;
    case 2003:
      print_source_line ();
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"type of formal parameter does not match previous declaration\n");
      break;
    case 2004:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"number of formal parameters does not match previous declaration\n");
      break;
    case 2005:
      print_source_line ();
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"name of formal paramter does not match previous declaration\n");
      break;
    case 2006:
      print_source_line ();
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"size of array subscript of formal parameter does not match previous declaration\n");
      break;
    case 2007:
      print_source_line ();
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"number of array subscripts of formal parameter does not match previous declaration\n");
      break;
    case 2008 :
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"structure has no member named `%s'\n", 
		text);
      break;
    case 2009:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"request for member `%s' in something not a structure or union\n",
		text);
      break;
    case 2010:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"too few arguments to function `%s'\n",
		text);
      break;
    case 2011:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"too many arguments to function `%s'\n",
		text);
      break;
    case 2012:
    {
      char *name = va_arg(point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"long, short, signed or unsigned invalid for `%s'\n",
		name);
    }
    break;
    case 2013:
    {
      char *name = va_arg(point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"long or short specified with char for `%s'\n",
		name);
    }
    break;
    case 2014:
    {
      char *name = va_arg(point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"short, signed or unsigned invalid for `%s'\n",
		name);
    }
    break;
    case 2015:
    {
      char *name = va_arg(point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"signed and unsigned given together for `%s'\n",
		name);
    }
    break;
    case 2016:
    {
      char *name = va_arg(point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"long and short specified together for `%s'\n",
		name);
    }
    break;
    case 2017:
    {
#if 0
      char *name = va_arg(point, char *);
#endif
      ERROR_FULL_INFO(spf[s].line_counter);
#if 0
      fprintfx (stderr,
		"multiple storage classes in declaration of `%s'\n",
		name);
#else
      fprintfx (stderr, "multiple storage classes in declaration\n");
#endif
    }
    break;
    case 2018:
    {
      char *name = va_arg(point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"storage class specified for parameter `%s'\n",
		name);
    }
    break;

      /* \verbatim */
      /* \verbatim{comp_maint_c_errors_3.tex} */
    case 3000:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"`break' outside loop or switch\n");
      break;
    case 3001:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"bad used `continue'\n");
      break;
    case 3002:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"default label not within a switch statement\n");
      break;
    case 3003:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"multiple default labels in one switch\n");
      ERROR_FULL_INFO(fixp->switch1.def_use.line_number);
      fprintfx (stderr,
		"this is the first default label\n");
      break;
    case 3004:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"duplicate label `%s'\n",
		text);
      break;
    case 3005:
      ERROR_FULL_INFO(error_line_number);
      fprintfx (stderr,
		"label `%s' used but not defined\n", 
		text);
      break;
      
      /* \verbatim */
      /* \verbatim{comp_maint_c_errors_4.tex} */

    case 4000:
      ERR_NO_INFO;
      fprintfx (stderr,
		"interpreter: full memory\n");
      break;
    case 4001:
      ERR_NO_INFO;
      fprintfx (stderr,
		"interpreter: stack overflow\n");
      break;
    case 4002:
      ERR_NO_INFO;
      fprintfx (stderr,
		"operating system out of memory\n");
      break;
    case 4003:
      ERR_NO_INFO;
      fprintfx (stderr,
		"interpreter: Undefined symbol `main'\n");
      break;
    case 4004:
      ERR_NO_INFO;
      fprintfx (stderr,
		"cannot set signals\n");
      break;
      
      /* \verbatim */
      /* \verbatim{comp_maint_c_errors_5.tex} */

    case 5000:
      fprintfx (stderr,
		"Compile Fatal ");
      ERR_NO_INFO;
      fprintfx (stderr,
		"Interpreter Internal Error (unknown operand type) in line %d e-mail: %s\n",
		spf[s].line_counter, EMAIL);
      print_source_line ();
      fprintfx (stderr, "\n");
      break;
    case 5001:
      fprintfx (stderr,
		"Run-time Fatal ");
      ERR_NO_INFO;
      fprintfx (stderr,
		" Internal Interpreter Error (unknown instruction) e-mail: %s\n", 
		EMAIL);
      print_source_line ();
      fprintfx (stderr, "\n");
      break;
    case 5002:
      fprintfx (stderr,
		"Compile Fatal ");
      ERR_NO_INFO;
      fprintfx (stderr,
		" Interpreter Internal Error (error in book-keeping) in line %d e-mail: %s\n",
		spf[s].line_counter, EMAIL);
      print_source_line ();
      fprintfx (stderr, "\n");
      break;
    case 5003:
      fprintfx (stderr,
		"Compile Fatal ");
      ERR_NO_INFO;
      fprintfx (stderr,
		" Internal Interpreter Error (error in operand type) in line %d e-mail: %s\n",
		spf[s].line_counter, EMAIL);
      print_source_line ();
      fprintfx (stderr, "\n");
      break;
      
      /* \verbatim */
      /* \verbatim{comp_maint_c_errors_6.tex} */

    case 6000:
      if (warning_yes)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "remote function %s already declared\n",
		    text);
	}
      goto end;
    case 6001:
      if (warning_yes || warning_return_type)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "`return' with no value, in function returning non-void\n");
	}
      goto end;
    case 6002:
      if (warning_yes || warning_return_type)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "`return' with a value, in function returning void\n");
	}
      goto end;
    case 6003:
      if (warning_extra || warning_unused)
	{
	  if (proc_name_text[proc])
	    {
	      ERROR_INFO;
	      fprintfx (stderr,
			"unused variable `%s'\n",
			text);
	    }
	  else
	    {
	      print_file_name ();
	      fprintfx (stderr, 
			" In block finishing at line %d:\n",
			spf[s].line_counter);
	      ERROR_INFO;
	      fprintfx (stderr,
			"unused variable `%s'\n",
			text);
	    }
	}
      goto end;
    case 6004:
      if (warning_yes || warning_unused)
	{
	  ERROR_FULL_INFO(error_line_number);
	  fprintfx (stderr,
		    "label `%s' defined but not used\n", 
		    text);
	}
      goto end;
    case 6005:
      if (warning_yes || warning_comment)
	{
	  ERROR_INFO;
	  fprintfx (stderr,
		    " `/*' within comment\n");
				/* Comment within comment. */
	}
      goto end;
    case 6006:
      if (warning_yes || warning_uninitialized)
	{
	  if (proc_name_text[proc])
	    {
	      ERROR_INFO;
	      fprintfx (stderr,
			"`%s' might be used uninitialized in this function\n",
			text);
	    }
	  else
	    {
	      print_file_name ();
	      fprintfx (stderr, 
			" In block finishing at line %d:\n",
			spf[s].line_counter);
	      ERROR_INFO;
	      fprintfx (stderr,
			"`%s' might be used uninitialized in the block\n",
			text);
	    }
	}
      goto end;
    case 6007:
      if (warning_extra)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "number of locals is greater than the ANSI allows\n");
	}
      goto end;
    case 6008:
      if (warning_extra)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "number of params is greater than the ANSI allows\n");
	}
      goto end;
    case 6009:
      if (warning_yes || warning_implicit)
	{
				/* Rather silly approach of finding
				   anonymous declarations inside
				   parameter lists. */
	  char *tmp_line, *beg, *end, *com;
	  int n, n_tmp_line = strlen(line_buf);
	  tmp_line = malloc(n_tmp_line + 1);
	  if (NULL == tmp_line)
	    {
	      perror ("");
	      abort ();
	    }
	  
	  strcpy (tmp_line, line_buf);
	  beg = strrchr (tmp_line, '(');
	  if (NULL == beg)
	    beg = tmp_line;
	  else
	    beg++;
	  n = strlen (beg);
	  if (',' == beg[n - 1])
	    beg[n - 1] = '\0';
	  com = strrchr (beg, ',');
	  if (NULL != com)
	    beg = com + 1;
	  for (; *beg == ' ' || *beg == '\t'; beg++);
	  
	  end = strrchr (beg, ' ');
	  com = strchr (beg, ' ');
	  if (end != com)
	    *end = '\0';
	  else
	    tmp_line[n_tmp_line - 1] = '\0';
	  
	  n = strlen(beg);
	  if (beg[n - 1] == ' ')
	    beg[n - 1] = '\0';
	  
	  com = strchr (beg, ' ');

	  ERROR_FULL_INFO(spf[s].line_counter);
	  if (beg[0] == '\0')
	    abort ();
	  if (NULL == com)
	    fprintfx (stderr,
		      "anonymous %s declared inside parameter list\n", beg);
	  else
	    fprintfx (stderr,
		      "`%s' declared inside parameter list\n", beg);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "its scope is only this definition or declaration,\n");
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr, "which is probably not what you want.\n");
	  free (tmp_line);
	}
      goto end;
    case 6010:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"useless keyword or type name in empty declaration\n");
      goto end;
    case 6011:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,	"empty declaration\n");
      goto end;
    case 6012:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"assignment makes %s from %s without a cast\n",
		POINTER_P(type_com[set - 1])? "pointer":
		type2string (type_com[set - 1]),
		POINTER_P(type_com[set])? "pointer":
		type2string (type_com[set]));
      goto end;
    case 6013:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"assignment from incompatible pointer type\n");
      goto end;
    case 6014:
      if (warning_yes || warning_format)
	{
	  char buf[2];
	  buf[0] = va_arg(point, char);
	  buf[1] = va_arg(point, char);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "use of `%c' length character with `%c' type character\n",
		    buf[0], buf[1]);
	}
      goto end;
    case 6015:
      if (warning_yes || warning_format)
	{
	  int arg = va_arg(point, int);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "long long int format, different type arg (arg %d)\n",
		    arg);
	}
      goto end;
    case 6016:
      if (warning_yes || warning_format)
	{
	  int arg = va_arg(point, int);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "long long unsigned int format, different type arg (arg %d)\n",
		    arg);
	}
      goto end;
    case 6017:
      if (warning_yes || warning_format)
	{
	  struct internal_type *type = va_arg(point, struct internal_type *);
	  int arg = va_arg(point, int);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "%s format, different type arg (arg %d)\n",
		    type2string (type), arg);
	}
      goto end;
    case 6018:
      if (warning_yes || warning_format)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "spurious trailing `%%' in format\n");
	}
      goto end;
    case 6019:
      if (warning_yes || warning_format)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "conversion lacks type at end of format\n");
	}
      goto end;
    case 6020:
      if (warning_yes || warning_format)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "repeated ` ' flag in format\n");
	}
      goto end;
    case 6021:
      if (warning_yes || warning_format)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "too few arguments for format\n");
	}
      goto end;
    case 6022:
      if (warning_yes || warning_format)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr, "too many arguments for format\n");
	}
      goto end;
    case 6023:
      if (warning_yes || warning_format)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr, "embedded `\\0' in format\n");
	}
      goto end;
    case 6024:
      if (warning_yes)
	{
	  struct internal_type *type1 = va_arg (point, 
						struct internal_type *),
	    *type2 = va_arg (point, struct internal_type *);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "comparison between %s and %s\n",
		    type2string (type1), type2string (type2));
	}
      goto end;
    case 6025:
    {
      char *type = va_arg(point, char *);
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,	"duplicate `%s'\n", type);
    }
    goto end;
    case 6026:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "overflow in implicit constant conversion\n");
      goto end;
    case 6027:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "statement with no effect\n");
      goto end;
    case 6028:
      if (warning_yes && strcmp (text, "main"))
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "control reaches end of non-void function\n");
	}
      goto end;
    case 6029:
      if (warning_yes)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "left-hand operand of comma expression has no effect\n"); 
	}
      goto end;
    case 6030:
      if (warning_yes)
	{
	  char *name = va_arg(point, char *);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "missing braces around initializer for `%s'\n", name);
	}
      goto end;
    case 6031:
      if (warning_yes || warning_format)
	{
	  struct internal_type *type = va_arg(point, struct internal_type *);
	  int arg = va_arg(point, int);
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "%s format, pointer arg (arg %d)\n",
		    type2string (type), arg);
	}
      goto end;
    case 6032:
      if (warning_yes || warning_trigraphs)
	{
	  static int no_trig;
	  no_trig++;
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "trigraph encountered\n");
	}
      goto end;
    case 6033:
    {
      char *name = va_arg(point, char *); 
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr, "unknown escape sequence `\\%s'\n",
		name);
    }
    goto end;
    case 6034:
      if (warning_aggregate_return)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "function returns an aggregate\n");
	}
      goto end;
    case 6035:
      if (warning_aggregate_return)
	{
	  ERROR_FULL_INFO(spf[s].line_counter);
	  fprintfx (stderr,
		    "function call has aggregate value\n");
	}
      goto end;

      /* \verbatim */
      /* \verbatim{comp_maint_c_errors_7.tex} */

    case 7000:
      print_error_number (err_no);
      fprintfx (stderr,
		"in run-string and/or in `clif.ini' file\n");
      break;
    case 7001:
      print_error_number (err_no);
      fprintfx (stderr,
		"interpreter: can't open file %s\n",
		spf[s].name);
      break;
    case 7002:
      print_error_number (err_no);
      fprintfx (stderr,
		"`-fcall-by-value' and `-fcall-by-reference' are conflicting options. `-fcall-by-reference' ignored.\n");
      break;
    case 7003:
      ERROR_FULL_INFO(spf[s].line_counter);
      fprintfx (stderr,
		"`-fhandle-main' option and syntax on this line are conflicting.\n");
      break;
  
    default:
      fprintfx (stderr,
		"Fatal error invalid error number (%d) e-mail: %s\n",
		err_no, EMAIL);
      break;

      /* \verbatim */

    }
  COMPILE_ONLY;
  end:
  if (error_count > 10)
    {
      fprintfx (stderr,
		"too many errors giving up\n");
      exit (1);
    }
  va_end(point);
  return;
}

static void
print_file_name ()
{
  static char *function_name;

  fprintfx (stderr, "%s:", spf[s].name);
  if (proc && ! func_def_f
      && function_name != proc_name_text[proc]
      && proc_name[proc] == NULL)
    {
      fprintfx (stderr, " In function `%s':\n",
		proc_name_text[proc]);
      function_name = proc_name_text[proc];
      fprintfx (stderr, "%s:", spf[s].name);      
    }
  else if (proc > 1 && 
	   function_name != proc_name_text[1]
	   && proc_name[1] == NULL)
    {
      fprintfx (stderr, " In function `%s':\n",
		proc_name_text[1]);
      function_name = proc_name_text[1];
      fprintfx (stderr, "%s:", spf[s].name);      
    }
  return;
}

static void
print_source_line ()
{
  if (source_line_number != spf[s].line_counter)
    {
      fprintfx (stderr, "\nSource line: %s\n", line_buf);
      fprintfx (stderr, "            %*s^", char_counter, " ");
      fprintfx (stderr, "\n");
      source_line_number = spf[s].line_counter;
    }
  return;
}

static void
print_error_number (err_no)
  int err_no;
{
#ifdef LONG_ERROR
  if (6000 > err_no && 7000 <= err_no)
    fprintfx (stderr, " Error %d:", err_no);
  else
    fprintfx (stderr, " Warning %d:", err_no);
#else
  if (6000 <= err_no && 7000 > err_no)
    fprintfx (stderr, " warning: ", err_no);
  else
    fprintfx (stderr, " ");
#endif
}


static void
print_line_number (line_no)
  int line_no;
{
#ifdef LONG_ERROR
  fprintfx (stderr, "line %d:", line_no);
#else
  fprintfx (stderr, "%d:", line_no);
#endif
}


static char *
type2string (type)
  struct internal_type *type;
{
  if (POINTER_P(type) || ARRAY_P(type))
    return "pointer";

  switch (type->attribute.arit_class)
    {
    case UNSIGNED_AC | CHR:
    case INTEGER:
      return "integer";
    case DOUB:
      return "double";
    case FLT:
      return "float";
    case CHR:
      return "char";
    case VID:
      return "void";
    default:
      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
      error_message (5000);
      abort ();
    }
}


/*
 * Transformation of type to global type. Used in calling of remote functions
 * with export type.
 */
int
type_transform (type, typec, flag)
  enum intern_arit_class type;
  enum intern_func_class typec;
  int flag;
{
  if (flag)
    {
      switch (typec)
	{
	case REMOTE_F :		/* Fall through. */
	case LOCAL :
	case SIMPLE:
	case ARRAY:
	case ENUM_FC:
	  switch (type)
	    {
	    case SIGNED_AC | CHR:
	      return (SCHRS);
	    case UNSIGNED_AC | CHR:
	      return (UCHRS);
	    case CHR:
	      return (CHRS);
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      return (INTEGERS);
	    case UNSIGNED_AC | INTEGER:
	      return (UINTEGERS);
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      return (LINTEGERS);
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      return (LUINTEGERS);
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      return (SINTEGERS);
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      return (SUINTEGERS);
	    case DOUB:
	      return (DOUBS);
	    case LONG_AC | DOUB:
	      return (LDOUBS);
	    case FLT:
	      return (FLTS);
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  break;
#if 0
	case ARRAY:
	  switch (type)
	    {
	    case CHR:
	      return (CHRS);
	    case INTEGER:
	      return (INTEGERS);
	    case DOUB:
	      return (DOUBS);
	    case FLT:
	      return (FLTS);
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
#endif
	default :
	  fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	  error_message (5000);
	  abort ();
	}
    } 
  else
    {
      switch (typec)
	{
	case REMOTE_F:	/* Fall through. */
	case LOCAL:
	case ENUM_FC:
	case POINTER:
	case SIMPLE:
	  switch (type)
	    {
	    case SIGNED_AC | CHR:
	      return (SCHRS);
	    case UNSIGNED_AC | CHR:
	      return (UCHRS);
	    case CHR:
	      return (CHRS);
	    case INTEGER:
	    case SIGNED_AC | INTEGER:
	      return (INTEGERS);
	    case UNSIGNED_AC | INTEGER:
	      return (UINTEGERS);
	    case LONG_AC | INTEGER:
	    case LONG_AC | SIGNED_AC | INTEGER:
	      return (LINTEGERS);
	    case LONG_AC | UNSIGNED_AC | INTEGER:
	      return (LUINTEGERS);
	    case SHORT_AC | INTEGER:
	    case SHORT_AC | SIGNED_AC | INTEGER:
	      return (SINTEGERS);
	    case SHORT_AC | UNSIGNED_AC | INTEGER:
	      return (SUINTEGERS);
	    case DOUB:
	      return (DOUBS);
	    case LONG_AC | DOUB:
	      return (LDOUBS);
	    case FLT:
	      return (FLTS);
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	  break;
	case ARRAY:
	  switch (type)
	    {
	    case CHR:
	      return (CHRAR);
	    case INTEGER:
	      return (INTEGERAR);
	    case DOUB:
	      return (DOUBAR);
	    case FLT:
	      return (FLTAR);
	    default:
	      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	      error_message (5000);
	      abort ();
	    }
	default :
	  fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	  error_message (5000);
	  abort ();
	}
    }
  return (-1);
}


/*
 * Functions for control of type specifiers and formal parameter names in
 * function declarations.
 */

/*
 * There is only a list of specifiers.
 */

int
add_to_spec_list ()
{
  struct internal_type *tmp_l;

  if (NULL == l_type_spec)
    {
      l_type_spec = copy_type (typeh[type_spec_count]);

      if (ARRAY_P(typeh[type_spec_count])
	  && -1 == add_subs_to_spec_list (&l_type_spec)
	  && -1 == add_subs_to_spec_list (&(typeh[type_spec_count])))
	return (-1);
    }
  else
    {
      tmp_l = l_type_spec;
      while (NULL != tmp_l->arity)
	tmp_l = tmp_l->arity;
      tmp_l->arity = copy_type (typeh[type_spec_count]);

      if (ARRAY_P(typeh[type_spec_count])
	  && -1 == add_subs_to_spec_list (&tmp_l->arity)
	  && -1 == add_subs_to_spec_list (&(typeh[type_spec_count])))
	return (-1);
    }
  return (0);
}

/* There are identifiers as well. */

int
add_to_ident_list ()
{
  struct ident_list_str *tmp_l;

  if (NULL == ident_list)
    {
      ident_list = (struct ident_list_str *) 
	allocate (sizeof (struct ident_list_str), PERM);
      ident_list->ident = text;
      ident_list->next = NULL;
    }
  else
    {
      tmp_l = ident_list;
      while (NULL != tmp_l->next)
	tmp_l = tmp_l->next;
      tmp_l->next = (struct ident_list_str *)
	allocate (sizeof (struct ident_list_str), PERM);
      tmp_l->next->ident = text;
      tmp_l->next->next = NULL;
    }
  return (0);
}


/* Compares if 2 trees are */
/* equivalent. It is needed in */
/* comparing specification in */
/* declaration and definition. */
int
compare2trees (table, def)
  struct internal_type *table, *def;
{
  /* If there is a function pointer in the function declaration just
     update the structure with with more specific information; i.e.

     int f(int (*)(), double (*)[3]);
     int f(int (*)(char *), double (*)[]);

     will be internally:

     int f(int (*)(char *), double (*)[3]); */
  if (table->attribute.function_class == LOCAL &&
      def->attribute.function_class == LOCAL)
    {
      if (table->input == NULL && def->input != NULL)
	table->input = copy_type (def->input);
      else if (table->input != NULL && def->input == NULL)
	def->input = copy_type (table->input);
    }
  /* Comparing if the trees have the */
  /* same structure. */
  if (((NULL != table->input) && (NULL == def->input)) ||
      ((NULL == table->input) && (NULL != def->input)))
    {
      error_message (2003);
      return (-1);
    }
  if (((NULL != table->output) && (NULL == def->output)) ||
      ((NULL == table->output) && (NULL != def->output)))
    {
      error_message (2003);
      return (-1);
    }
  if (((NULL != table->arity) && (NULL == def->arity)) ||
      ((NULL == table->arity) && (NULL != def->arity)))
    {
      /* If a tree has domain and another */
      /* not, number of subscripts does not */
      /* match. */
      if (((NULL != table->attribute.domain) && 
	   (NULL == def->attribute.domain)) ||
	  ((NULL == table->attribute.domain) &&
	   (NULL != def->attribute.domain)))
	{
	  error_message (2007);
	  return (-1);
	} 
      else if ((NULL == table->attribute.domain) &&
	       (NULL == def->attribute.domain))
	{
	  error_message (2004);
	  return (-1);
	} 
      else
	{
	  error_message (2007);
	  return (-1);
	}
    }
  /* If a tree has domain and another */
  /* not, number of subscripts does not */
  /* match. */
  if (((NULL != table->attribute.domain) && 
       (NULL == def->attribute.domain)) ||
      ((NULL == table->attribute.domain) &&
       (NULL != def->attribute.domain)))
    {
      error_message (2007);
      return (-1);
    }
  if ((NULL != table->attribute.domain) && 
      (NULL != def->attribute.domain))
    {
      if (NOT_DEFINED == ((struct range *) table->attribute.domain)->upper)
	{
	  ((struct range *) table->attribute.domain)->upper =
	    ((struct range *) def->attribute.domain)->upper;
	}
      /* The same subscript has to have the */
      /* same range. */
      /* NOT_DEFINED is [] in the declaration of the */
      /* first subscript. */
      if (NOT_DEFINED != 
	  ((struct range *) def->attribute.domain)->upper &&
	  ((((struct range *) table->attribute.domain)->lower !=
	    ((struct range *) def->attribute.domain)->lower) ||
	   (((struct range *) table->attribute.domain)->upper !=
	    ((struct range *) def->attribute.domain)->upper)))
	{
	  error_message (2006);
	  return (-1);
	}
    }
  /* Comparing two structure contents. */
  if ((table->attribute.function_class !=
       def->attribute.function_class) ||
      (table->attribute.export_type !=
       def->attribute.export_type) ||
      (table->attribute.memory_size != def->attribute.memory_size))
    {
      error_message (2003);
      return (-1);
    }
  /* Comparing attribute aritmetical */
  /* class. */
  if (table->attribute.arit_class != def->attribute.arit_class)
    {
      error_message (2003);
      return (-1);
    }
  /* Compare structure recursively. */
  if ((NULL != table->input) && (NULL != def->input) &&
      (-1 == compare2trees (table->input, def->input)))
    /* Error propagation. */
    return (-1);
  if ((NULL != table->arity) && (NULL != def->arity) &&
      (-1 == compare2trees (table->arity, def->arity)))
    /* Error propagation. */
    return (-1);
  if ((NULL != table->output) && (NULL != def->output) &&
      (-1 == compare2trees (table->output, def->output)))
    /* Error propagation. */
    return (-1);
  /* Free the comparing structure again. */
#if 0
  free (def);
#endif
  return (0);
}


/* Copy internal type. Used in function declaration or definition. */
static struct internal_type *
copy_type (type)
  struct internal_type *type;
{
  struct internal_type *new_type;

  if (NULL == type)
    return NULL;
  
  new_type = (struct internal_type *)
    allocate (sizeof (struct internal_type), PERM);
  new_type->input = type->input;
  new_type->arity = type->arity;
  new_type->field_name = type->field_name;
  new_type->offset = type->offset;
  new_type->attribute.function_class = type->attribute.function_class;
  new_type->attribute.export_type = type->attribute.export_type;
  new_type->attribute.type_qualifier = type->attribute.type_qualifier;
  new_type->attribute.storage_class_specifier =
    type->attribute.storage_class_specifier;
  new_type->attribute.arit_class = type->attribute.arit_class;
  new_type->attribute.memory_size = type->attribute.memory_size;
  new_type->attribute.domain = type->attribute.domain;
  new_type->output = type->output;

  return new_type;
}


/*
 * Adding information about arrays to the list of specifiers.
 */

static int
add_subs_to_spec_list (type)
  struct internal_type **type;
{
  int             count_tmp;

  count_tmp = poc;

  (*type)->input = (struct internal_type *) 
    allocate (sizeof (struct internal_type), PERM);
  (*type)->input->attribute.arit_class = INTEGER;
  (*type)->input->attribute.domain = (char *) 
    allocate (sizeof (struct range), PERM);
  ((struct range *) (*type)->input->attribute.domain)->lower = 0;
  ((struct range *) (*type)->input->attribute.domain)->upper =
    dim[count_tmp--];
  if (-1 != dim[count_tmp])
    {
      struct internal_type *walk;

      walk = (struct internal_type *)
	allocate (sizeof (struct internal_type), PERM);
      walk->attribute.arit_class = INTEGER;
      walk->attribute.domain = (char *)
	allocate (sizeof (struct range), PERM);
      ((struct range *) walk->attribute.domain)->lower = 0;
      ((struct range *) walk->attribute.domain)->upper = dim[count_tmp--];
      (*type)->input->arity = walk;
      while (-1 != dim[count_tmp])
	{
	  walk->arity = (struct internal_type *)
	    allocate (sizeof (struct internal_type), PERM);
	  walk = walk->arity;
	  walk->attribute.arit_class = INTEGER;
	  walk->attribute.domain = (char *)
	    allocate (sizeof (struct range), PERM);
	  ((struct range *) walk->attribute.domain)->lower = 0;
	  ((struct range *) walk->attribute.domain)->upper =
	    dim[count_tmp--];
	}
    }
  return (0);
}


void
clear_internal_type (def)
  struct internal_type *def;
{
  struct internal_type *cyclic_pointer;
  
  if (POINTER_P(def) &&
      NULL != (cyclic_pointer = cyclic_def (def, def->output)))
    cyclic_pointer->output = NULL;
  if (NULL != def->input)
    clear_internal_type (def->input);
  if (NULL != def->arity)
    clear_internal_type (def->arity);
  if (NULL != def->output)
    clear_internal_type (def->output);
  if (NULL != def->attribute.domain)
    {
#if 0
      free (def->attribute.domain);
#endif
      return;
    }
#if 0
  free (def);
#endif
  return;
}

void
search_duplicate_labels ()
{
  int             counter = 1, i;

  if ((SWITCH == fixp->switch1.major) && (NULL != fixp->switch1.next))
    {
      tmp_c = fixp->switch1.next;
      while (NULL != tmp_c->next)
	{
	  tmp_c = tmp_c->next;
	  tmp_m = fixp->switch1.next;
	  counter++;
	  /* Finding duplicate labels in the */
	  /* list. (a little bit awkward) */
	  for (i = 1; i < counter; i++)
	    {
	      if (tmp_m->constant == tmp_c->constant)
		{
		  error_message (1015);
		  return;
		}
	      tmp_m = tmp_m->next;
	    }
	}
    }
  else
    {
      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
      error_message (5002);
      abort ();
    }
  return;
}

int
add_constant_to_list (int_const)
  int             int_const;
{
  union fix      *fixp_arch;
  struct list_const1 *ptr;

  /* The current value of the fixative pointer is stored for the next
     usage. (If in the nested if case is used.) */
  fixp_arch = fixp;	

  while (IF == fixp->if1.major)
    fixp--;

  if (fixp == (union fix *) fixst)
    {
      error_message (1016);
      fixp = fixp_arch;
      return (1);
    }
  /* All things we are doing only for */
  /* good error message production. */
  if (SWITCH == fixp->switch1.major)
    {
      if (NULL == fixp->switch1.next)
	{
	  fixp->switch1.next = (struct list_const1 *)
	    allocate (sizeof (struct list_const1), PERM);

	  /* We need line number and constant. */
	  fixp->switch1.next->line_number = spf[s].line_counter;
	  fixp->switch1.next->constant = int_const;
	  fixp->switch1.next->next = NULL;
	}
      else
	{
	  ptr = fixp->switch1.next;
	  while (NULL != ptr->next)
	    ptr = ptr->next;
	  ptr->next = (struct list_const1 *)
	    allocate (sizeof (struct list_const1), PERM);
	  ptr->next->line_number = spf[s].line_counter;
	  ptr->next->constant = int_const;
	  ptr->next->next = NULL;
	}
    } 
  else
    {
      error_message (1016);
      fixp = fixp_arch;
      return (1);
    }
  
  fixp = fixp_arch;

  return (0);
}

void
add_default_to_fixp ()
{
  union fix      *fixp_arch;

  /* The current value of the fixative pointer is stored for the next
     usage. (If in the nested if default is used.) */
  fixp_arch = fixp;

  while (IF == fixp->if1.major)
    fixp--;

  if (fixp == (union fix *) fixst)
    {
      error_message (3002);
      fixp = fixp_arch;
      return;
    }
  if (SWITCH == fixp->switch1.major)
    {
      /* Only one default statement per */
      /* switch. */
      if (0 == fixp->switch1.def_use.def_flag)
	{
	  fixp->switch1.def_use.def_flag = 1;
	  fixp->switch1.def_use.line_number = spf[s].line_counter;
	  fixp->switch1.def_use.adr = kodp;
	} 
      else
	{
	  error_message (3003);
	  fixp = fixp_arch;
	  return;
	}
    }
  else
    {
      error_message (3002);
      fixp = fixp_arch;
      return;
    }

  fixp = fixp_arch;

  return;
}


/* Functions for setting and resetting of the flag of function
   definition context. */
void
func_def_s ()
{
  func_def_f = 1;
}


void
func_def_r ()
{
  func_def_f = 0;
}


/* The function is used in 2 different contexts: 
   - during the function declaration or definition 
   - when entering a block.  

   If a function is defined, the scope is changed already when the
   opening parenthesis of formal arguments is parsed. So, afterwards
   when opening bracket of the context of a compound statement is
   parsed the scope level cannot be changed.

   When a new block is parsed (not in the context of a function
   definition) context is changed during the parsing of left
   bracket. */
void
enter_scope ()
{
  if (func_def_f)
    func_def_f = 0;
  else
    scope_level++;
}


void
exit_scope ()
{
  clear_hash_tab ();
  clear_tag_tab ();
  scope_level ? scope_level-- : 0;
}


static void
mov2lvalue (typec, type)
  struct internal_type *typec;
  enum intern_arit_class type;
{
  switch (typec->attribute.function_class)
    {
    case POINTER:
    case ARRAY:
    case SIMPLE:
      switch (type)
	{
	case INTEGER:
	case SIGNED_AC | INTEGER:
	  GEN_MOVi;
	  break;
	case UNSIGNED_AC | INTEGER:
	  GEN_MOVui;
	  break;
	case LONG_AC | INTEGER:
	case LONG_AC | SIGNED_AC | INTEGER:
	  GEN_MOVli;
	  break;
	case LONG_AC | UNSIGNED_AC | INTEGER:
	  GEN_MOVlui;
	  break;
	case SHORT_AC | INTEGER:
	case SHORT_AC | SIGNED_AC | INTEGER:
	  GEN_MOVsi;
	  break;
	case SHORT_AC | UNSIGNED_AC | INTEGER:
	  GEN_MOVsui;
	  break;
	case DOUB: 
	  GEN_MOVd;
	  break;
	case LONG_AC | DOUB:
	  GEN_MOVld;
	  break;
	case FLT:
	  GEN_MOVf;
	  break;
	case CHR:
	  GEN_MOVc;
	  break;
	case SIGNED_AC | CHR:
	  GEN_MOVsc;
	  break;
	case UNSIGNED_AC | CHR:
	  GEN_MOVuc;
	  break;
	default :
	  fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	  error_message (5000); 
	  abort ();
	}
      GENCODE;
      break;
    case ENUM_FC:
      if (INTEGER == type)
	{
	  GEN_MOVi;
	  GENCODE;
	}
      else
	{
	  fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
	  error_message (5000);
	  abort ();
	}
      break;
    case STRUCT_FC:
    case UNION_FC:
    {
      register int i;

      for (i = 0; i < typec->attribute.memory_size; i++)
	{
	  GEN_PUSHAIi(i); GENCODE;
	  GEN_MOVbv; GENCODE;
	}
    }
    GEN_POPAe; GENCODE;
    break;
    default:
				/* FIXME: */
      fprintfx (stderr, "%s:%d:\n", __FILE__, __LINE__);
      error_message (5002);
      abort ();
      break;
    }
}


/* Generate right MOV instructruction. */
void
move2lvalue ()
{
  mov2lvalue (type_com[set], type_ac[set]);
}


/* Compare if pointers to 2 types are comaptible. */
static int
type_compare (type1, type2)
  struct internal_type *type1, *type2;
{
  if (POINTER_P(type2) && ARRAY_P(type1) && 
      type1->output == type2->output) 
    {
#if 0
      error_message (1028);
#endif
      GEN_MOVpa; GENCODE;
    }
  else if (POINTER_P(type2) && ARRAY_P(type1))
    error_message (1028);
  else if (POINTER_P(type1) && POINTER_P(type2) 
	   && SIMPLE_P(type1->output) && SIMPLE_P(type2->output))
    {
      if (type1->output->attribute.arit_class ==
	  type2->output->attribute.arit_class)
	return 0;
      else
	error_message (6013);
    }
  else if (POINTER_P(type1) && POINTER_P(type2) &&
	   type1->output != type2->output)
    error_message (1028);
  return 0;
}


/* Find cycles in pointer definitions and declarations. */ 
static struct internal_type *
cyclic_def (type1, type2)
  struct internal_type *type1, *type2;
{
  struct internal_type *result = NULL;
  
  if (type1 == NULL)
    {
      fprintfx (stderr, "%s:%d: cyclic_def with bad parameter\n",
		__FILE__, __LINE__);
      abort ();
    }

  if (type2 == NULL)
    return result;

  if (POINTER_P(type2) && type1->output == type2->output)
    result = type2;

  if (!result && type2->input != NULL)
    result = cyclic_def (type1, type2->input);
  if (!result && type2->arity != NULL)
    result = cyclic_def (type1, type2->arity);
  if (!result && type2->output != NULL)
    result = cyclic_def (type1, type2->output);

  return result;
}


/* Combination of all hashing tables. Choose the appropriate one and
   put the variable there.*/
void
put2table (name, type)
  char *name;
  struct internal_type *type;
{
  struct internal_type *walk = type;
  
  while (walk && !STATIC_P(walk))
    walk = walk->output;
  
  if (walk && proc == 0)
    {
      if (UNUSED_AC == walk->attribute.arit_class)
	walk->attribute.arit_class = INTEGER;
      enter_file_scope ();
      if (-1 == has_loc (VAR, name))
	COMPILE_ONLY;
    }
  else if (NULL != proc_name_text[proc] && type != NULL)
    {
      if (-1 == has_loc (VAR, name))
	COMPILE_ONLY;
    }
  else if (-1 == has (name))
    COMPILE_ONLY;
}


/* Number of args for a function is returned. */
int
get_num_args (type)
  struct internal_type *type;
{
  register struct internal_type *walk;
  register int n;
  
  if (type && (REMOTE_P(type) || LOCAL_P(type)))
    {
      walk = type->input;
      for (n = 0; walk; walk = walk->arity, n++)
	if (VOID_P(walk))
	  n--;
    }
  return n;
}


/* Type promotion. */
void
promote_type ()
{
  switch (type_ac[set])
    {
    case CHR:
      GEN_CVTCIt; GENCODE;
      type_ac[set] = INTEGER;
      break;
    case FLT:
      GEN_CVTFDt; GENCODE;
      type_ac[set] = DOUB;
      break;
    default:			/* Yup, it's ok here */
      break;
    }
}

/* Arrange all things for starting main */
static int
start_main ()
{
  extern char *string PROTO((char *));
  struct ident_tab *ptr;

  /* This version supports main only without arguments. I have to
     change it to return appropriate values and parse input args. */
  text = string ("main");
  ptr = point (text);
  if (NULL == ptr)
    {
      error_message (4003);
      return 1;
    }
  pc = kodp;
  GEN_CALL(ptr->adr); GENCODE;
  GEN_STOP; GENCODE;
  return 0;
}


/* Checks if specified type specifiers are valid. If not issues
   error_message. */
void
check_spec_constr (type, name)
  struct internal_type *type;
  char *name;
{
  if (POINTER_P(type) || ARRAY_P(type) ||
      LOCAL_P(type) || REMOTE_P(type))
    while (type->output)
      type = type->output;
  
  if (VOID_P(type))
    {
      if (SIGNED_P(type) || UNSIGNED_P(type) ||
	  LONG_P(type) || SHORT_P(type))
	error_message (2012, name);
    }
  else if (CHAR_P(type))
    {
      if (LONG_P(type) || SHORT_P(type))
	error_message (2013, name);
    }
  else if (INTEGER_P(type))
      ;
  else if (FLOAT_P(type))
    {
      if (SIGNED_P(type) || UNSIGNED_P(type) ||
	  LONG_P(type) || SHORT_P(type))
	error_message (2012, name);
    }
  else if (DOUBLE_P(type))
    {
      if (SIGNED_P(type) || UNSIGNED_P(type) ||
	  SHORT_P(type))
	error_message (2014, name);
    }
  else if (! TYPEDEF_P(type) &&
	   ! (UNSPEC_P (type) && UNDEF_P(type) &&  UNUSED_P(type)))
    type->attribute.arit_class += INTEGER;
  else if (TYPEDEF_P(type))
      ;
  else
    error_message (5003);
  
  if (SIGNED_P(type) && UNSIGNED_P(type))
    error_message (2015, name);
  else if (LONG_P(type) && SHORT_P(type))
    error_message (2016, name);
}


void
gen_cast_needed ()
{
  if (call_by_value)
    {
      GEN_CVTFDt; GENCODE;
      type_ac[set] = DOUB;
      type_com[set] = (struct internal_type *)
	allocate (sizeof (struct internal_type), PERM);
      init_zero ((char *)type_com[set],
		 sizeof(struct internal_type));
      type_com[set]->attribute.function_class = SIMPLE;
      type_com[set]->attribute.type_qualifier = UNDEF_TQ;
      type_com[set]->attribute.arit_class = type_ac[set];
      type_com[set]->attribute.memory_size = sizeof (double);
      
    }
}
