/***********************************************************************
     "d2c.o": lotos Data language to C.
***********************************************************************/

/***********************************
  (C) Copyright 1992-1993; dit/upm
   Distributed under the conditions stated in the
   TOPO General Public License (see file LICENSE)
 ***********************************
 $Log: d2c.c,v $
 * Revision 2.15  1995/01/17  09:55:27  lotos
 * dynamic table sizing
 *
 * Revision 2.14  1994/12/19  15:13:57  lotos
 * new convention for pieces
 *
 * Revision 2.13  1993/06/10  14:04:25  lotos
 * new annotation CALL
 *
 * Revision 2.12  1993/06/01  13:35:09  lotos
 * error en la funcion de evaluacion
 *
 * Revision 2.11  1993/05/28  10:51:50  lotos
 * opcion -c tiene niveles
 *
 * Revision 2.10  1993/05/25  11:02:30  lotos
 * anotaciones ldcend y ldcinit pasan al principio
 *
 * Revision 2.9  1993/03/24  17:48:31  lotos
 * annotation partial accepts $$
 * annotation partial with $# adds spaces as required
 *
 * Revision 2.8  1993/01/18  18:32:21  lotos
 * cleaning of would-be-generated files, under file breaking
 *
 * Revision 2.6  1993/01/12  18:37:56  lotos
 * portability issues
 * allow a prefix for a single piece
 *
 * Revision 2.5  1993/01/12  14:25:49  lotos
 * do not complaint if there is a prefix but no pieces to break into
 *
 * Revision 2.4  1992/12/09  10:49:55  lotos
 * split into pieces
 *
 * Revision 2.3  1992/12/02  11:04:48  lotos
 * active proper option to instantiate 'draw'
 *
 * Revision 2.2  1992/11/17  18:35:08  lotos
 * separate internal (kdatum) and external (udatum)
 * new annotation ldc at the very and of the spec
 * new annotation ldcinit at the beginning
 *
 * Revision 2.1  1992/10/14  18:16:00  lotos
 * new philosophy to write ADTs,
 * every new expression is supposed to be pointed once,
 * in order to share a value, it has to be kd_copy'ed
 * functions assume their arguments are absolutely theirs
 *
 * Revision 1.8  1992/10/14  18:07:53  lotos
 * forget ophuscation
 *
 * Revision 1.7  1992/09/02  14:04:23  lotos
 * avoid casting on LHS (for portability)
 *
 * Revision 1.6  92/05/06  18:46:25  lotos
 * main() and exit(): fixed to shut lint up!
 *
 * Revision 1.5  92/02/29  13:27:01  lotos
 * flags for pretty printing: optional
 *
 * Revision 1.4  92/01/15  12:45:07  lotos
 * ready to distribute
 *
 * Revision 1.3  91/11/20  13:28:38  lotos
 * parse and eval code added
 *
 * Revision 1.2  91/11/14  12:51:08  lotos
 * term builders fixed
 *
 * Revision 1.1  91/10/02  17:00:40  lotos
 * Initial revision
 *
 ***********************************/

#include "version.h"
#ifndef lint
static char rcsid[]= "$Id: d2c.c,v 2.15 1995/01/17 09:55:27 lotos Exp $";
#endif

#define d2c_IMP

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "d2c.hh"

/* KJT 20/01/23: added function prototypes */
int unlink(const char *pathname);

/* KJT 11/03/98: added for NS/OS */

#ifdef __NeXT__
char *strdup(s) register char *s; {

  register char *ns;

  return(((ns=malloc(strlen(s)+1))==0)?0:strcpy(ns,s)); }
#endif

/* statistics for splitting */

struct
{ struct
  { int dcl;
    int dfn;
  } srt;
  struct
  { int dcl;
    int dfn;
  } opn;
} splt_stat = { { 0 ,0 }, { 0, 0 } };

/* returns a splitting file name */

PRIVATE char *
splt_file (pic)
  int pic;
{
  static int first= TRUE;
  static char fn[BUFSIZ];
  static int dg= 0;
  char *p;

  if (first)
  { int i;

    abort_if(prog_flag.splt_pics == 0)
    for (i= prog_flag.splt_pics - 1; i > 0; i/= 10)
      ++dg;
    first= FALSE;
  }
  abort_if(pic < 0 ||
	   pic >= prog_flag.splt_pics)
  p= fn;
  (void) strcpy(p, prog_flag.splt_prfx);
  if (pic > 0)
  { p+= strlen(p);
    (void) sprintf(p, "%0*u", dg, pic);
  }
  p+= strlen(p);
  (void) strcpy(p, ".c");
  return fn;
}

/* opens a new splitting file */

PRIVATE void
new_splt_file ()
{
  static int pic= -1;
  char *fn;

  fn= splt_file(++pic);
  if (freopen(fn, "w", stdout) == NULL)
  { (void) fprintf(stderr,
		   "%s: cannot open file \"%s\"\n", prog_name, fn);
    exit(1);
  }
  if (pic > 0)
  { indent();
    (void) printf("#%s \"%s\"\n", C_INCLUDE, prog_flag.hdr_file);
  }
}

/* translation initialization */

PRIVATE sREC *
trn_init ()
{
  if (prog_flag.splt_pics != 0)
    new_splt_file();
  init_indt(prog_flag.indt_incr);
  indent();
  (void) printf("#%s %s\n", C_DEFINE, CODE_NAME);
  (void) printf("\n");
  indent();
  (void) printf("#%s \"%s\"\n", C_INCLUDE, prog_flag.hdr_file);
  ign_empty_rec= TRUE;
  return get_rec();
}

/* skips ldc annotation (at the beginning) */

PRIVATE sREC *
skp_ldc_ant (rec)
  sREC *rec;
{
  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  if (field(rec, 1, SYM) != BEGIN_ANNOTATION ||
      field(rec, 2, SYM) != LDC_ANNOTATION)
    return rec;
  while (rec= get_rec(),
	 field(rec, 1, SYM) != END_ANNOTATION)
    continue;
  return get_rec();
}

/* to storage ldcinit annotation */
PRIVATE char *ldi_ant= NULL;

/* translates ldcinit annotation */

PRIVATE sREC *
trn_ldi_ant (rec)
  sREC *rec;
{
  char *ldi_line;

  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  if (field(rec, 1, SYM) != BEGIN_ANNOTATION ||
      field(rec, 2, SYM) != LDCINIT_ANNOTATION)
    return rec;
  for (;;)
  { switch (rec= get_rec(), field(rec, 1, SYM))
    { case LINE_QUOTE:
	ldi_line= field(rec, 2, STR) + 1;
	if (ldi_ant == NULL)
	  ldi_ant= strdup(ldi_line);
	else
	{ trealloc(ldi_ant, strlen(ldi_ant) + strlen(ldi_line) + 2);
	  (void) strcat(ldi_ant, "\n");
	  (void) strcat(ldi_ant, ldi_line);
	}
	continue;
      case END_ANNOTATION:
	break;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  return get_rec();
}

/* to storage ldc annotation (at the end) */
PRIVATE char *lde_ant= NULL;

/* translates ldc annotation (at the end) */

PRIVATE sREC *
trn_lde_ant (rec)
  sREC *rec;
{
  char *lde_line;

  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  if (field(rec, 1, SYM) != BEGIN_ANNOTATION ||
      field(rec, 2, SYM) != LDCEND_ANNOTATION)
    return rec;
  for (;;)
  { switch (rec= get_rec(), field(rec, 1, SYM))
    { case LINE_QUOTE:
	lde_line= field(rec, 2, STR) + 1;
	if (lde_ant == NULL)
	  lde_ant= strdup(lde_line);
	else
	{ trealloc(lde_ant, strlen(lde_ant) + strlen(lde_line) + 2);
	  (void) strcat(lde_ant, "\n");
	  (void) strcat(lde_ant, lde_line);
	}
	continue;
      case END_ANNOTATION:
	break;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  return get_rec();
}

/* prints an open bracket */

#define open_bracket(chr)				\
	{						\
	  (void) printf("%c", (chr));			\
	  if (prog_flag.indt_incr > 1)			\
	    (void) printf(" ");				\
	}

/* prints a close bracket */

#define close_bracket(chr)				\
	{						\
	  if (prog_flag.indt_incr > 1)			\
	    (void) printf(" ");				\
	  (void) printf("%c", (chr));			\
	}

/* starts to print a table entry */

#define start_tbl_entry()				\
	{						\
	  if (prog_flag.add_cmt > 1)			\
	    advc_indt(DFLT_INDT, FILL, "{");		\
	  else						\
	    open_bracket('{');				\
	}

/* prints the name of a key in a table entry */

#define _name_tbl_key(name) \
	  ((void) printf("/* %s= */ ", (name)))

/* introduces to print first key in a table entry */

#define first_tbl_key(name)				\
	{						\
	  if (prog_flag.add_cmt > 1)			\
	    _name_tbl_key(name);			\
	}

/* introduces to print next key in a table entry */

#define next_tbl_key(name)				\
	{						\
	  if (prog_flag.add_cmt > 1)			\
	  { (void) printf(",\n");			\
	    indent();					\
	    _name_tbl_key(name);			\
	  }						\
	  else						\
	    (void) printf(", ");			\
	}

/* finishes to print a table entry */

#define finish_tbl_entry()				\
	{						\
	  if (prog_flag.add_cmt > 1)			\
	  { (void) printf("\n");			\
	    decr_indt();				\
	    indent();					\
	    (void) printf("}");				\
	  }						\
	  else						\
	    close_bracket('}');				\
	}

PRIVATE int max_srt= -1;
PRIVATE sREC **srt_dcl= NULL;

/* translates sort declarations */

PRIVATE sREC *
trn_srt_dcls (rec)
  sREC *rec;
{
  static char **cmt_srt_dcl= NULL;
  static char **free_srt_dcl= NULL;
  static char **equal_srt_dcl= NULL;
  static char **draw_srt_dcl= NULL;
  static char **parse_srt_dcl= NULL;
  int srt_uid;
  sREC *srt_info;
  char *srt_cmt= NULL;
  char *srt_free;
  char *srt_equal;
  char *srt_draw;
  char *srt_parse;
  int ant_type;
  char *ant_line, *ant_text;
  int i;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BEGIN_SORTS_DECL)
  abort_if(max_srt != -1)
  max_srt= field(rec, 2, INT);
  abort_if(srt_dcl != NULL)
  talloc(srt_dcl, max_srt + 1);
  for (i= 0; i <= max_srt; ++i)
    srt_dcl[i]= NULL;
  abort_if(cmt_srt_dcl != NULL)
  talloc(cmt_srt_dcl, max_srt + 1);
  for (i= 0; i <= max_srt; ++i)
    cmt_srt_dcl[i]= NULL;
  abort_if(free_srt_dcl != NULL)
  talloc(free_srt_dcl, max_srt + 1);
  for (i= 0; i <= max_srt; ++i)
    free_srt_dcl[i]= NULL;
  abort_if(equal_srt_dcl != NULL)
  talloc(equal_srt_dcl, max_srt + 1);
  for (i= 0; i <= max_srt; ++i)
    equal_srt_dcl[i]= NULL;
  abort_if(draw_srt_dcl != NULL)
  talloc(draw_srt_dcl, max_srt + 1);
  for (i= 0; i <= max_srt; ++i)
    draw_srt_dcl[i]= NULL;
  abort_if(parse_srt_dcl != NULL)
  talloc(parse_srt_dcl, max_srt + 1);
  for (i= 0; i <= max_srt; ++i)
    parse_srt_dcl[i]= NULL;
  for (;;)
  { switch (rec= get_rec(), field(rec, 1, SYM))
    { case COMMENT:
	if (prog_flag.add_cmt > 0)
	  srt_cmt= strdup(field(rec, 2, STR) + 1);
	continue;
      case SORT_DECL:
	srt_uid= -field(rec, 3, INT);
	abort_if(max_srt < srt_uid)
	srt_dcl[srt_uid]= dup_rec(rec);
	if (srt_cmt != NULL)
	{ cmt_srt_dcl[srt_uid]= srt_cmt;
	  srt_cmt= NULL;
	}
	++splt_stat.srt.dcl;
	if (field(rec, 5, SYM) == DEFINED)
	  ++splt_stat.srt.dfn;
	continue;
      case BEGIN_ANNOTATION:
	ant_type= field(rec, 2, SYM);
	ant_text= NULL;
	continue;
      case LINE_QUOTE:
	ant_line= field(rec, 2, STR) + 1;
	if (ant_text == NULL)
	  ant_text= strdup(ant_line);
	else
	{ trealloc(ant_text, strlen(ant_text) + strlen(ant_line) + 2);
	  (void) strcat(ant_text, "\n");
	  (void) strcat(ant_text, ant_line);
	}
	continue;
      case END_ANNOTATION:
	switch (ant_type)
	{ case FREE_ANNOTATION:
	    free_srt_dcl[srt_uid]= ant_text;
	    break;
	  case EQUAL_ANNOTATION:
	    equal_srt_dcl[srt_uid]= ant_text;
	    break;
	  case DRAW_ANNOTATION:
	    draw_srt_dcl[srt_uid]= ant_text;
	    break;
	  case PARSE_ANNOTATION:
	    parse_srt_dcl[srt_uid]= ant_text;
	    break;
	  default:
	    abort_if(TRUE)
	    break;
	}
	continue;
      case END_SORTS_DECL:
	break;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  for (i= 0; i <= max_srt; ++i)
  { srt_info= srt_dcl[i];
    srt_cmt= prog_flag.add_cmt > 1? cmt_srt_dcl[i]: NULL;
    srt_free= free_srt_dcl[i];
    srt_equal= equal_srt_dcl[i];
    srt_draw= draw_srt_dcl[i];
    srt_parse= parse_srt_dcl[i];
    if (i == 0)
    { (void) printf("\n");
      if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("/* %s %s */\n", CMT_BEGIN, CMT_SORT_TBL);
      }
      indent();
      advc_indt(0, FILL, "%s %s= ", K_TYPE_SORT_TBL, K_SORT_TBL);
      advc_indt(DFLT_INDT, FILL, "{");
    }
    else
    { (void) printf(",\n");
      indent();
    }
    if (srt_info == NULL)
    { open_bracket('{');
      (void) printf("0, %s, %s, %s, %s, %s, %s",
		    K_FALSE, K_NULL, K_NULL, K_NULL, K_NULL, K_NULL);
      close_bracket('}');
      continue;
    }
    if (srt_cmt != NULL)
    { (void) printf("/* %s */\n", srt_cmt);
      indent();
    }
    start_tbl_entry();
    first_tbl_key(K_SID);
    (void) printf("%d", -field(srt_info, 3, INT));
    next_tbl_key(K_ISEXTERN);
    (void) printf("%s", field(srt_info, 5, SYM) == DEFINED? K_FALSE:
							    K_TRUE);
    next_tbl_key(K_NAME);
    (void) printf("\"%s\"", sym_name(field(srt_info, 4, SYM)));
    next_tbl_key(K_FREE);
    (void) printf("%s", srt_free == NULL? K_NULL: srt_free);
    next_tbl_key(K_EQUAL);
    (void) printf("%s", srt_equal == NULL? K_NULL: srt_equal);
    next_tbl_key(K_DRAW);
    (void) printf("%s", srt_draw == NULL? K_NULL: srt_draw);
    next_tbl_key(K_PARSE);
    (void) printf("%s", srt_parse == NULL? K_NULL: srt_parse);
    finish_tbl_entry();
  }
  if (max_srt >= 0)
  { (void) printf("\n");
    decr_indt();
    indent();
    (void) printf("};\n");
    decr_indt();
    (void) printf("\n");
    indent();
    (void) printf("%s %s= %d;\n", C_UNSIGNED,
		  K_SIZE_SORT_TBL, max_srt + 1);
    if (prog_flag.add_cmt > 1)
    { indent();
      (void) printf("/* %s %s */\n", CMT_END, CMT_SORT_TBL);
    }
  }
  return get_rec();
}

/* returns TRUE if EOL was reached when printing argument buffer */

#define arg_buf_eol(ndx)	((ndx) % 10 == 0)

/* translates operation declarations */

PRIVATE sREC *
trn_opn_dcls (rec)
  sREC *rec;
{
  static int max_opn= -1;
  static char **cmt_opn_dcl= NULL;
  static sREC **opn_dcl= NULL;
  static int *call_opn_dcl= NULL;
  int max_arg= 0;
  int arg_cnt= 0;
  int eval_1st= TRUE;
  int arg_inc;
  int opn_uid;
  sREC *opn_info;
  char *opn_cmt= NULL;
  int opn_call;
  char *opn_name;
  int opn_sort;
  int opn_args;
  int max_opn_args= 0;
  int *opn_sarg= NULL;
  int i, imax, j;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BEGIN_OPERATIONS_DECL)
  abort_if(max_opn != -1)
  max_opn= field(rec, 2, INT);
  abort_if(cmt_opn_dcl != NULL)
  talloc(cmt_opn_dcl, max_opn + 1);
  for (j= 0; j <= max_opn; ++j)
    cmt_opn_dcl[j]= NULL;
  abort_if(opn_dcl != NULL)
  talloc(opn_dcl, max_opn + 1);
  for (j= 0; j <= max_opn; ++j)
    opn_dcl[j]= NULL;
  abort_if(call_opn_dcl != NULL)
  talloc(call_opn_dcl, max_opn + 1);
  for (j= 0; j <= max_opn; ++j)
    call_opn_dcl[j]= FALSE;
  for (;;)
  { switch (rec= get_rec(), field(rec, 1, SYM))
    { case COMMENT:
	if (prog_flag.add_cmt > 0)
	  opn_cmt= strdup(field(rec, 2, STR) + 1);
	continue;
      case OPERATION_DECL:
	opn_uid= field(rec, 3, INT);
	abort_if(max_opn < opn_uid)
	opn_dcl[opn_uid]= dup_rec(rec);
	if (opn_cmt != NULL)
	{ cmt_opn_dcl[opn_uid]= opn_cmt;
	  opn_cmt= NULL;
	}
	++splt_stat.opn.dcl;
	if (field(rec, 5, SYM) == DEFINED)
	  ++splt_stat.opn.dfn;
	continue;
      case BEGIN_ANNOTATION:
	switch (field(rec, 2, SYM))
	{ case CALL_ANNOTATION:
	    call_opn_dcl[opn_uid]= TRUE;
	    break;
	  default:
	    abort_if(TRUE)
	    break;
	}
	continue;
      case LINE_QUOTE:
	continue;
      case END_ANNOTATION:
	continue;
      case END_OPERATIONS_DECL:
	break;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  for (j= 0; j <= max_opn; ++j)
  { opn_info= opn_dcl[j];
    opn_cmt= prog_flag.add_cmt > 1? cmt_opn_dcl[j]: NULL;
    if (opn_info == NULL)
      continue;
    arg_inc= field(opn_info, 7, INT);
    if (arg_inc == 0)
      continue;
    if (max_arg == 0)
    { (void) printf("\n");
      if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("/* %s %s */\n", CMT_BEGIN, CMT_ARG_BUF);
      }
      indent();
      advc_indt(0, FILL, "%s %s %s[]= ", C_STATIC, C_INT, ARG_BUF);
      advc_indt(DFLT_INDT, FILL, "{");
    }
    else
    { (void) printf(",");
      if (prog_flag.add_cmt > 1 ||
	  arg_buf_eol(max_arg))
      { (void) printf("\n");
	indent();
      }
      else
	(void) printf(" ");
    }
    if (opn_cmt != NULL)
    { (void) printf("/* %s */\n", opn_cmt);
      indent();
    }
    i= 8;
    imax= i + arg_inc;
    for (;;)
    { (void) printf("%d", -field(opn_info, i, INT));
      ++max_arg;
      if (++i == imax)
	break;
      (void) printf(",");
      if (prog_flag.add_cmt > 1 ||
	  !arg_buf_eol(max_arg))
	(void) printf(" ");
      else
      { (void) printf("\n");
	indent();
      }
    }
  }
  if (max_arg > 0)
  { (void) printf("\n");
    decr_indt();
    indent();
    (void) printf("};\n");
    decr_indt();
    if (prog_flag.add_cmt > 1)
    { indent();
      (void) printf("/* %s %s */\n", CMT_END, CMT_ARG_BUF);
    }
  }
  (void) printf("\n");
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("/* %s %s */\n", CMT_BEGIN, CMT_EVAL_OPN);
  }
  indent();
  (void) printf("%s %s(%s, %s)\n", K_DATUM,
		EVAL_OPN, EVAL_OID, EVAL_ARG);
  indent();
  (void) printf("%s %s;\n", C_INT, EVAL_OID);
  indent();
  (void) printf("%s %s[];\n", K_DATUM, EVAL_ARG);
  indent();
  advc_indt(DFLT_INDT, NOFILL, "{\n");
  for (j= 0; j <= max_opn; ++j)
  { opn_info= opn_dcl[j];
    opn_cmt= prog_flag.add_cmt > 1? cmt_opn_dcl[j]: NULL;
    opn_call= call_opn_dcl[j];
    if (opn_info == NULL)
      continue;
    opn_args= field(opn_info, 7, INT);
    if (opn_args <= CMN_MAX_ARG && !opn_call)
      continue;
    if (eval_1st)
    { indent();
      (void) printf("%s (%s)\n", C_SWITCH, EVAL_OID);
      indent();
      advc_indt(DFLT_INDT, FILL, "{");
      eval_1st= FALSE;
    }
    else
      indent();
    if (opn_cmt != NULL)
    { (void) printf("/* %s */\n", opn_cmt);
      indent();
    }
    (void) printf("%s %d:\n", C_CASE, field(opn_info, 3, INT));
    opn_name= sym_name(field(opn_info, 2, SYM));
    opn_sort= -field(opn_info, 6, INT);
    if (opn_args > max_opn_args)
    { max_opn_args= opn_args;
      if (opn_sarg == NULL)
	talloc(opn_sarg, max_opn_args);
      else
	trealloc(opn_sarg, max_opn_args);
    }
    for (i= 0; i < opn_args; ++i)
      opn_sarg[i]= -field(opn_info, 8 + i, INT);
    if (opn_call && opn_args > 0)
    { indent();
      advc_indt(DFLT_INDT, FILL, "{");
      (void) printf("%s %s= ", K_DATUM, VAL_NAME);
    }
    else
    { incr_indt(DFLT_INDT);
      indent();
      (void) printf("%s ", C_RETURN);
    }
    if (field(srt_dcl[opn_sort], 5, SYM) != DEFINED)
      (void) printf("(%s) ", K_DATUM);
    (void) printf("%s(", opn_name);
    if (opn_args > 0)
    { i= 0;
      for (;;)
      { if (opn_call)
	{ if (field(srt_dcl[opn_sarg[i]], 5, SYM) == DEFINED)
	    (void) printf("%s(", K_FCOPY);
	  else
	    (void) printf("%s(%d, ", U_FCOPY, opn_sarg[i]);
	}
	if (field(srt_dcl[opn_sarg[i]], 5, SYM) != DEFINED)
	  (void) printf("(%s)", U_DATUM);
	(void) printf("%s[%d]", EVAL_ARG, i);
	if (opn_call)
	  (void) printf(")");
	if (++i == opn_args)
	  break;
	(void) printf(", ");
      }
    }
    (void) printf(");\n");
    if (opn_call && opn_args > 0)
    { for (i= 0; i < opn_args; ++i)
      { indent();
	if (field(srt_dcl[opn_sarg[i]], 5, SYM) == DEFINED)
	  (void) printf("%s(", K_FFREE);
	else
	  (void) printf("%s(%d, ", U_FFREE, opn_sarg[i]);
	if (field(srt_dcl[opn_sarg[i]], 5, SYM) != DEFINED)
	  (void) printf("(%s)", U_DATUM);
	(void) printf("%s[%d]", EVAL_ARG, i);
	if (opn_call)
	  (void) printf(");\n");
      }
      indent();
      (void) printf("%s %s;\n", C_RETURN, VAL_NAME);
      decr_indt();
      indent();
      (void) printf("}\n");
    }
    else
      decr_indt();
  }
  if (eval_1st)
  { indent();
    (void) printf("%s %s;\n", C_RETURN, K_NULL);
  }
  else
  { indent();
    (void) printf("%s:\n", C_DEFAULT);
    incr_indt(DFLT_INDT);
    indent();
    (void) printf("%s %s;\n", C_RETURN, K_NULL);
    decr_indt();
    decr_indt();
    indent();
    (void) printf("}\n");
  }
  decr_indt();
  indent();
  (void) printf("}\n");
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("/* %s %s */\n", CMT_END, CMT_EVAL_OPN);
  }
  if (opn_sarg != NULL)
  { tfree(opn_sarg);
    max_opn_args= 0;
    opn_sarg= NULL;
  }
  for (j= 0; j <= max_opn; ++j)
  { opn_info= opn_dcl[j];
    opn_cmt= prog_flag.add_cmt > 1? cmt_opn_dcl[j]: NULL;
    opn_call= call_opn_dcl[j];
    if (j == 0)
    { (void) printf("\n");
      if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("/* %s %s */\n", CMT_BEGIN, CMT_OPN_TBL);
      }
      indent();
      advc_indt(0, FILL, "%s %s= ", K_TYPE_OPN_TBL, K_OPN_TBL);
      advc_indt(DFLT_INDT, FILL, "{");
    }
    else
    { (void) printf(",\n");
      indent();
    }
    if (opn_info == NULL)
    { open_bracket('{');
      (void) printf("0, 0, 0, %s, %s, %s, %s, %s",
		    K_NULL, K_FALSE, K_FALSE, K_NULL, K_NULL);
      close_bracket('}');
      continue;
    }
    if (opn_cmt != NULL)
    { (void) printf("/* %s */\n", opn_cmt);
      indent();
    }
    start_tbl_entry();
    first_tbl_key(K_OID);
    (void) printf("%d", field(opn_info, 3, INT));
    next_tbl_key(K_SID);
    (void) printf("%d", -field(opn_info, 6, INT));
    arg_inc= field(opn_info, 7, INT);
    next_tbl_key(K_NARG);
    (void) printf("%d", arg_inc);
    next_tbl_key(K_SARG);
    if (arg_inc == 0)
      (void) printf("%s", K_NULL);
    else
    { (void) printf("%s", ARG_BUF);
      if (arg_cnt > 0)
	(void) printf(" + %d", arg_cnt);
      arg_cnt+= arg_inc;
    }
    next_tbl_key(K_ISEXTERN);
    (void) printf("%s", field(opn_info, 5, SYM) == DEFINED? K_FALSE:
							    K_TRUE);
    next_tbl_key(K_ISINFIX);
    (void) printf("%s", K_FALSE);
    next_tbl_key(K_NAME);
    (void) printf("\"%s\"", sym_name(field(opn_info, 4, SYM)));
    next_tbl_key(K_EVAL);
    if (arg_inc <= CMN_MAX_ARG && !opn_call)
      (void) printf("(%s(*)())%s",
		    K_DATUM, sym_name(field(opn_info, 2, SYM)));
    else
      (void) printf("%s", EVAL_OPN);
    finish_tbl_entry();
  }
  if (max_opn >= 0)
  { (void) printf("\n");
    decr_indt();
    indent();
    (void) printf("};\n");
    decr_indt();
    (void) printf("\n");
    indent();
    (void) printf("%s %s= %d;\n", C_UNSIGNED,
		  K_SIZE_OPN_TBL, max_opn + 1);
    if (prog_flag.add_cmt > 1)
    { indent();
      (void) printf("/* %s %s */\n", CMT_END, CMT_OPN_TBL);
    }
    abort_if(arg_cnt != max_arg)
  }
  return get_rec();
}

/* generates code for partial annotation */

PRIVATE sREC *
gc_ptl_ant (rec, args, sarg)
  sREC *rec;
  int args;
  int *sarg;
{
  int ln_1st= TRUE;
  sREC *ptl_hdr;
  char *ptl_line;
  char *p, *q, *r;
  int i, j;

  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  if (field(rec, 1, SYM) != BEGIN_ANNOTATION)
    return rec;
  abort_if(field(rec, 2, SYM) != PARTIAL_ANNOTATION)
  ptl_hdr= dup_rec(rec);
  for (;;)
  { switch (rec= get_rec(), field(rec, 1, SYM))
    { case LINE_QUOTE:
	if (ln_1st)
	{ if (args > 0)
	  { (void) printf("\n");
	    indent();
	  }
	  (void) printf("%s (!(", C_IF);
	  ln_1st= FALSE;
	}
	else
	  (void) printf("\n");
	ptl_line= field(rec, 2, STR) + 1;
	for (p= ptl_line; (q= strchr(p, '$')) != NULL; p= q)
	{ (void) printf("%.*s", q - p, p);
	  if (*(q + 1) == '$')
	  { (void) printf("$");
	    q+= 2;
	  }
	  else
	  { if (q > ptl_line && isascii(*(q - 1)) &&
		(isalnum(*(q - 1)) || *(q - 1) == '_'))
	      (void) printf(" ");
	    (void) printf("%s", ARG_ROOT);
	    for (r= ++q; isascii(*r) && isdigit(*r); ++r)
	      ;
	    abort_if(r == q)
	    (void) printf("%.*s", r - q, q);
	    if (*r != '\0' && isascii(*r) &&
		(isalnum(*r) || *r == '_'))
	      (void) printf(" ");
	    q= r;
	  }
	}
	(void) printf("%s", p);
	continue;
      case END_ANNOTATION:
	break;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  if (!ln_1st)
  { (void) printf("))\n");
    indent();
    advc_indt(DFLT_INDT, FILL, "{");
    (void) printf("%s(\"%s", K_PUT_ERROR, MSG_PTL_INTRO);
    (void) printf(": (%s %d %s \\\"%s\\\")\\n\");\n",
		  MSG_PTL_LINE, field(ptl_hdr, 4, INT),
		  MSG_PTL_FILE, sym_name(field(ptl_hdr, 5, SYM)));
    indent();
    (void) printf("%s(\"%*s: %s\\n\");\n", K_PUT_ERROR,
		  strlen(MSG_PTL_INTRO), MSG_PTL_OPN,
		  sym_name(field(ptl_hdr, 3, SYM)));
    for (i= 1, j= 1; i <= args; ++i)
    { if (i % 10 == 0)
	++j;
      indent();
      (void) printf("%s(\"%*s %d: ", K_PUT_ERROR,
		    strlen(MSG_PTL_INTRO) - j - 1, MSG_PTL_ARG, i);
      (void) printf("%%s\\n\", ");
      if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
	(void) printf("%s(", K_FDRAW);
      else
	(void) printf("%s(%d, ", U_FDRAW, sarg[i - 1]);
      (void) printf("%s%d));\n", ARG_ROOT, i);
    }
    indent();
    (void) printf("%s(1);\n", C_EXIT);
    decr_indt();
    indent();
    (void) printf("}\n");
    if (args == 0)
      indent();
  }
  del_rec(ptl_hdr);
  return get_rec();
}

/* writes a value reference */

PRIVATE void
wrt_ref (rec)
  sREC *rec;
{
  int iref, imax, ison;

  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  switch (field(rec, 1, SYM))
  { case OPERATION_MATCH:
      iref= 3;
      break;
    case VALUE_MATCH:
      iref= 2;
      break;
    case VALUE_EVAL:
      iref= 2;
      break;
    default:
      abort_if(TRUE)
      break;
  }
  (void) printf("%s%d", ARG_ROOT, field(rec, iref, INT));
  imax= nofld(rec);
  while (++iref, iref <= imax && fldty(rec, iref) == INT)
  { (void) printf("->%s", K_LNK);
    for (ison= field(rec, iref, INT) - 1; ison > 0; --ison)
      (void) printf("->%s", K_NEXT);
    (void) printf("->%s", K_ARG);
  }
}

/* writes a value expression */

PRIVATE void
wrt_exp (rec)
  sREC *rec;
{
  int sort;
  int equal_uid= 0;

  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  switch (field(rec, 1, SYM))
  { case OPERATION_EVAL:
      if (field(rec, 2, SYM) == EQUAL &&
	  nofld(rec) > 3 && fldty(rec, 4) == INT)
      { equal_uid= -field(rec, 4, INT);
	if (field(srt_dcl[equal_uid], 5, SYM) == DEFINED)
	  (void) printf("%s(", K_GRL_FEQUAL);
	else
	  (void) printf("%s(%d, ", U_GRL_FEQUAL, equal_uid);
      }
      else
	(void) printf("%s(", sym_name(field(rec, 2 ,SYM)));
      if (field(rec, 3, INT) > 0)
      { int args;

	for (args= field(rec, 3, INT);;)
	{ wrt_exp(get_rec());
	  if (--args == 0)
	    break;
	  (void) printf(", ");
	}
      }
      if (equal_uid != 0)
      { (void) printf(", 0x%x", 0x1 | (0x1 << 1));
	equal_uid= 0;
      }
      (void) printf(")");
      break;
    case ANNOTATION:
      abort_if(field(rec, 2, SYM) != SORT_ANNOTATION)
      sort= -field(rec, 3, INT);
      if (field(srt_dcl[sort], 5, SYM) == DEFINED)
	(void) printf("%s(", K_FCOPY);
      else
	(void) printf("%s(%d, (%s)", U_FCOPY, sort, U_DATUM);
      rec= get_rec();
      abort_if(field(rec, 1, SYM) != VALUE_EVAL)
      wrt_ref(rec);
      (void) printf(")");
      break;
    case VALUE_EVAL:
      abort_if(TRUE)
      break;
    default:
      abort_if(TRUE)
      break;
  }
}

/* generates code for rewrite rules of a CONSTANT operation */

PRIVATE sREC *
gc_cns_rules (rec)
  sREC *rec;
{
  int rule_cnt= 0;
  int cond_cnt;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BEGIN_RULE)
  for (;; rec= get_rec())
  { switch (field(rec, 1, SYM))
    { case BEGIN_RULE:
	cond_cnt= 0;
	continue;
      case BEGIN_COMMENT:
      case LINE_QUOTE:
      case END_COMMENT:
	continue;
      case BEGIN_PATTERN:
      case END_PATTERN:
	continue;
      case BEGIN_CONDITION:
	if (cond_cnt == 0)
	{ if (rule_cnt == 0)
	    advc_indt(0, FILL, "%s (", C_IF);
	  else
	  { indent();
	    advc_indt(0, FILL, "%s (", C_ELSE_IF);
	  }
	}
	else
	{ (void) printf(" &&\n");
	  indent();
	}
	wrt_exp(get_rec());
	continue;
      case END_CONDITION:
	++cond_cnt;
	continue;
      case BEGIN_REPLACEMENT:
	if (cond_cnt > 0)
	{ (void) printf(")\n");
	  decr_indt();
	  incr_indt(DFLT_INDT);
	  indent();
	}
	else if (rule_cnt > 0)
	{ indent();
	  (void) printf("%s\n", C_ELSE);
	  incr_indt(DFLT_INDT);
	  indent();
	}
	(void) printf("%s= ", VAL_NAME);
	wrt_exp(get_rec());
	(void) printf(";\n");
	if (cond_cnt > 0 || rule_cnt > 0)
	  decr_indt();
	continue;
      case END_REPLACEMENT:
	continue;
      case END_RULE:
	++rule_cnt;
	continue;
      case BUILD:
      case END_OPERATION_DEF:
	break;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  return rec;
}

/* generates code for rewrite rules of a REAL operation */

PRIVATE sREC *
gc_opn_rules (rec)
  sREC *rec;
{
  int new_ptn;
  int nest_lvl= 0;
  int nest_cnt;
  int lbl_1st;
  int rule_cnt= 0;
  int cond_cnt= 0;
  int start= TRUE;
  int finish= FALSE;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BEGIN_RULE)
  (void) printf("\n");
  for (;; rec= get_rec())
  { switch (field(rec, 1, SYM))
    { case BEGIN_RULE:
	continue;
      case BEGIN_COMMENT:
      case LINE_QUOTE:
      case END_COMMENT:
	continue;
      case BUILD:
      case END_OPERATION_DEF:
	finish= TRUE;
      case BEGIN_PATTERN:
	if (finish)
	{ new_ptn= TRUE;	/* from ... to NULL pattern */
	  nest_cnt= 0;
	}
	else
	{ new_ptn= field(rec, 3, INT) != 0;
	  nest_cnt= field(rec, 2, INT);
	  if (new_ptn)
	    ++nest_cnt;
	  else if (start)
	    new_ptn= TRUE;	/* from NULL pattern to ... */
	}
	abort_if(new_ptn && !start? nest_cnt > nest_lvl
				  : nest_cnt != nest_lvl)
	if (new_ptn)
	{ for (; nest_cnt < nest_lvl; --nest_lvl)
	  { indent();
	    (void) printf("%s;\n", C_BREAK);
	    decr_indt();
	    decr_indt();
	    indent();
	    (void) printf("}\n");
	  }
	  if (finish)
	    break;
	  if (start)
	  { lbl_1st= TRUE;
	    start= FALSE;
	  }
	  else
	  { indent();
	    (void) printf("%s;\n", C_BREAK);
	    decr_indt();
	    lbl_1st= FALSE;
	  }
	}
	nest_cnt= 0;
	continue;
      case OPERATION_MATCH:
      case VALUE_MATCH:
	if (++nest_cnt >= nest_lvl && new_ptn)
	{ if (lbl_1st)
	  { abort_if(field(rec, 1, SYM) != OPERATION_MATCH)
	    indent();
	    (void) printf("%s (", C_SWITCH);
	    wrt_ref(rec);
	    (void) printf("->%s)\n", K_OPN);
	    indent();
	    advc_indt(DFLT_INDT, FILL, "{");
	  }
	  else
	  { indent();
	    lbl_1st= TRUE;
	  }
	  if (field(rec, 1, SYM) == OPERATION_MATCH)
	    (void) printf("%s %d:", C_CASE, field(rec, 2, INT));
	  else
	    (void) printf("%s:", C_DEFAULT);
	  if (fldty(rec, nofld(rec) - 1) == SYM &&
	      field(rec, nofld(rec) - 1, SYM) == COMMENT)
	    if (prog_flag.add_cmt > 0)
	      (void) printf(" /*%s */", field(rec, nofld(rec), STR));
	  (void) printf("\n");
	  incr_indt(DFLT_INDT);
	}
	continue;
      case END_PATTERN:
	abort_if(new_ptn? nest_cnt < nest_lvl
			: nest_cnt != nest_lvl)
	nest_lvl= nest_cnt;
	if (new_ptn)
	  rule_cnt= 0;
	cond_cnt= 0;
	continue;
      case BEGIN_CONDITION:
	if (cond_cnt == 0)
	{ indent();
	  if (rule_cnt == 0)
	    advc_indt(0, FILL, "%s (", C_IF);
	  else
	    advc_indt(0, FILL, "%s (", C_ELSE_IF);
	}
	else
	{ (void) printf(" &&\n");
	  indent();
	}
	wrt_exp(get_rec());
	continue;
      case END_CONDITION:
	++cond_cnt;
	continue;
      case BEGIN_REPLACEMENT:
	if (cond_cnt > 0)
	{ (void) printf(")\n");
	  decr_indt();
	  incr_indt(DFLT_INDT);
	}
	else if (rule_cnt > 0)
	{ indent();
	  (void) printf("%s\n", C_ELSE);
	  incr_indt(DFLT_INDT);
	}
	indent();
	(void) printf("%s= ", VAL_NAME);
	wrt_exp(get_rec());
	(void) printf(";\n");
	if (cond_cnt > 0 || rule_cnt > 0)
	  decr_indt();
	continue;
      case END_REPLACEMENT:
	++rule_cnt;
	continue;
      case END_RULE:
	continue;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  return rec;
}

/* writes a term building failure */

PRIVATE void
wrt_bfl (rec, args, sarg)
  sREC *rec;
  int args;
  int *sarg;
{
  int i, j;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BUILD)
  abort_if(nofld(rec) < 5 ||
	   field(rec, 4, SYM) != ANNOTATION ||
	   field(rec, 5, SYM) != FAIL_ANNOTATION)
  (void) printf("%s(\"%s: (%s)\\n\");\n", K_PUT_ERROR,
		MSG_BFL_HINTRO, MSG_BFL_TINTRO);
  indent();
  (void) printf("%s(\"%*s: %s", K_PUT_ERROR,
		strlen(MSG_BFL_HINTRO), MSG_BFL_OPN,
		sym_name(field(rec, 6, SYM)));
  (void) printf(" (%s %d %s \\\"%s\\\")\\n\");\n",
		MSG_BFL_LINE, field(rec, 7, INT),
		MSG_BFL_FILE, sym_name(field(rec, 8, SYM)));
  for (i= 1, j= 1; i <= args; ++i)
  { if (i % 10 == 0)
      ++j;
    indent();
    (void) printf("%s(\"%*s %d: ", K_PUT_ERROR,
		  strlen(MSG_BFL_HINTRO) - j - 1, MSG_PTL_ARG, i);
    (void) printf("%%s\\n\", ");
    if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
      (void) printf("%s(", K_FDRAW);
    else
      (void) printf("%s(%d, ", U_FDRAW, sarg[i - 1]);
    (void) printf("%s%d));\n", ARG_ROOT, i);
  }
  indent();
  (void) printf("%s(1);\n", C_EXIT);
}

/* writes a term building */

PRIVATE void
wrt_bld (rec, args)
  sREC *rec;
  int args;
{
  int i, j;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BUILD)
  (void) printf("%s= %s();\n", VAL_NAME, K_FALLOC);
  indent();
  (void) printf("%s->%s= %d;\n", VAL_NAME, K_OPN, field(rec, 2, INT));
  for (i= 1, j= 1; i <= args; ++i, ++j)
  { if (j > 2)
      j= 1;
    (void) printf("\n");
    indent();
    (void) printf("%s%d= %s();\n", LNK_ROOT, j, K_FLINK);
    indent();
    (void) printf("%s%d->%s= (%s)%s%d;\n",
		  LNK_ROOT, j, K_ARG, K_DATUM, ARG_ROOT, i);
    indent();
    if (i == 1)
      (void) printf("%s->%s= %s%d;\n", VAL_NAME, K_LNK, LNK_ROOT, j);
    else
      (void) printf("%s%d->%s= %s%d;\n", LNK_ROOT, j % 2 + 1, K_NEXT,
		    LNK_ROOT, j);
  }
}

/* generates code for term building of a CONSTANT operation */

PRIVATE sREC *
gc_cns_build (rec, has_rules)
  sREC *rec;
  int has_rules;
{
  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BUILD)
  if (has_rules)
  { indent();
    (void) printf("%s\n", C_ELSE);
    indent();
    advc_indt(DFLT_INDT, FILL, "{");
  }
  if (nofld(rec) > 3)
    wrt_bfl(rec, 0, (int *)NULL);
  else
    wrt_bld(rec, 0);
  if (has_rules)
  { decr_indt();
    indent();
    (void) printf("}\n");
  }
  return get_rec();
}

/* generates code for term building of a REAL operation */

PRIVATE sREC *
gc_opn_build (rec, args, sarg, has_rules)
  sREC *rec;
  int args;
  int *sarg;
  int has_rules;
{
  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BUILD)
  (void) printf("\n");
  indent();
  if (has_rules)
  { (void) printf("%s (%s == %s)\n", C_IF, VAL_NAME, K_NULL);
    indent();
    advc_indt(DFLT_INDT, FILL, "{");
  }
  if (nofld(rec) > 3)
    wrt_bfl(rec, args, sarg);
  else
    wrt_bld(rec, args);
  if (has_rules)
  { decr_indt();
    indent();
    (void) printf("}\n");
  }
  return get_rec();
}

/* generates code for definition of a CONSTANT operation */

PRIVATE sREC *
gc_cns_dfn (rec)
  sREC *rec;
{
  char *cns_name;
  int sort;
  int has_rules;
  int has_build;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BEGIN_OPERATION_DEF ||
	   field(rec, 5, INT) != 0)
  cns_name= sym_name(field(rec, 2, SYM));
  sort= -field(rec, 4, INT);
  has_rules= field(rec, 3, SYM) != BUILD;
  has_build= field(rec, 3, SYM) != REWRITE;
  indent();
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  (void) printf(" %s()\n", cns_name);
  indent();
  advc_indt(DFLT_INDT, FILL, "{");
  (void) printf("%s ", C_STATIC);
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  (void) printf(" %s= %s;\n", VAL_NAME, K_NULL);
  (void) printf("\n");
  indent();
  (void) printf("%s (%s == %s)\n", C_IF, VAL_NAME, K_NULL);
  indent();
  advc_indt(DFLT_INDT, FILL, "{");
  rec= get_rec();
  rec= gc_ptl_ant(rec, 0, (int *)NULL);
  if (has_rules)
    rec= gc_cns_rules(rec);
  if (has_build)
    rec= gc_cns_build(rec, has_rules);
  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != END_OPERATION_DEF)
  indent();
  (void) printf("(%s) ", C_VOID);
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s(", K_FCONST);
  else
    (void) printf("%s(%d, ", U_FCONST, sort);
  (void) printf("%s);\n", VAL_NAME);

  decr_indt();
  indent();
  (void) printf("}\n");
  indent();
  (void) printf("%s %s;\n", C_RETURN, VAL_NAME);
  decr_indt();
  indent();
  (void) printf("}\n");
  return get_rec();
}

/* generates code for definition of a REAL operation */

PRIVATE sREC *
gc_opn_dfn (rec)
  sREC *rec;
{
  char *opn_name;
  int sort;
  int args;
  int *sarg;
  int has_rules;
  int has_build;
  int i;

  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != BEGIN_OPERATION_DEF ||
	   field(rec, 5, INT) == 0)
  opn_name= sym_name(field(rec, 2, SYM));
  sort= -field(rec, 4, INT);
  args= field(rec, 5, INT);
  talloc(sarg, args);
  for (i= 0; i < args; ++i)
    sarg[i]= -field(rec, 6 + i, INT);
  has_rules= field(rec, 3, SYM) != BUILD;
  has_build= field(rec, 3, SYM) != REWRITE;
  indent();
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  (void) printf(" %s(", opn_name);
  for (i= 1;; ++i)
  { (void) printf("%s%d", ARG_ROOT, i);
    if (i == args)
      break;
    (void) printf(", ");
  }
  (void) printf(")\n");
  for (i= 1;; ++i)
  { indent();
    if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
      (void) printf("%s", K_DATUM);
    else
      (void) printf("%s", U_DATUM);
    (void) printf(" %s%d;\n", ARG_ROOT, i);
    if (i == args)
      break;
  }
  indent();
  advc_indt(DFLT_INDT, FILL, "{");
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  (void) printf(" %s", VAL_NAME);
  if (has_rules && has_build)
    (void) printf("= %s", K_NULL);
  (void) printf(";\n");
  if (has_build)
  { indent();
    (void) printf("%s %s1", K_LINK, LNK_ROOT);
    if (args > 1)
      (void) printf(", %s2", LNK_ROOT);
    (void) printf(";\n");
  }
  rec= get_rec();
  rec= gc_ptl_ant(rec, args, sarg);
  if (has_rules)
    rec= gc_opn_rules(rec);
  if (has_build)
    rec= gc_opn_build(rec, args, sarg, has_rules);
  abort_if(rec == NULL ||
	   nofld(rec) == 0 ||
	   field(rec, 1, SYM) != END_OPERATION_DEF)
  if (has_rules)
  { if (has_build)
    { indent();
      (void) printf("%s\n", C_ELSE);
      indent();
      advc_indt(DFLT_INDT, FILL, "{");
    }
    else
    { (void) printf("\n");
      indent();
    }
    for (i= 1;; ++i)
    { if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
	(void) printf("%s(", K_FFREE);
      else
	(void) printf("%s(%d, ", U_FFREE, sarg[i - 1]);
      (void) printf("%s%d);\n", ARG_ROOT, i);
      if (i == args)
	break;
      indent();
    }
    if (has_build)
    { decr_indt();
      indent();
      (void) printf("}\n");
    }
  }
  (void) printf("\n");
  indent();
  (void) printf("%s %s;\n", C_RETURN, VAL_NAME);
  decr_indt();
  indent();
  (void) printf("}\n");
  tfree(sarg);
  return get_rec();
}

/* starts a new splitting atom */

PRIVATE void
new_splt_atom ()
{
  static int first= TRUE;
  static struct
  { int cnt;
    int inc;
    int min;
    int mid;
    int max;
  } atom= { 0, 0, 0, 0, 0 };

  if (first)
  { int pics;

    abort_if(prog_flag.splt_pics < 1)
    atom.min= (splt_stat.srt.dcl + splt_stat.opn.dcl) / 15;
    if (atom.min == 0)
      atom.min= 1;
    pics= prog_flag.splt_pics;
    for (;;)
    { atom.max= atom.min + splt_stat.opn.dfn;
      atom.inc= atom.max / pics;
      atom.mid= atom.max % pics;
      if (atom.mid == 0)
	atom.mid= -1;
      else
	atom.mid*= ++atom.inc;
      abort_if(atom.inc == 0)
      if (atom.min <= atom.inc)
	break;
      atom.min= 0;
      --pics;
    }
    atom.cnt= atom.min;
    atom.min= 0;
    first= FALSE;
  }
  if (atom.cnt == atom.mid)
  { --atom.inc;
    atom.max-= atom.mid;
    atom.mid= -1;
    atom.cnt= 0;
  }
  if (atom.cnt % atom.inc == 0)
    new_splt_file();
  ++atom.cnt;
}

/* translates operation definitions */

PRIVATE sREC *
trn_opn_dfns (rec)
  sREC *rec;
{
  int opn_1st= TRUE;

  for (;;)
  { if (rec == NULL)
      break;
    if (field(rec, 1, SYM) != COMMENT &&
	field(rec, 1, SYM) != BEGIN_OPERATION_DEF)
      break;
    if (prog_flag.splt_pics != 0)
      new_splt_atom();
    if (opn_1st)
    { (void) printf("\n");
      if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("/* %s %s */\n", CMT_BEGIN, CMT_OPN_DFNS);
      }
      opn_1st= FALSE;
    }
    else
      (void) printf("\n");
    if (field(rec, 1, SYM) == COMMENT)
    { if (prog_flag.add_cmt > 0)
      { indent();
	(void) printf("/*%s */\n", field(rec, 2, STR));
      }
      rec= get_rec();
      abort_if(rec == NULL ||
	       nofld(rec) == 0 ||
	       field(rec, 1, SYM) != BEGIN_OPERATION_DEF)
    }
    if (field(rec, 5, INT) == 0)
      rec= gc_cns_dfn(rec);
    else
      rec= gc_opn_dfn(rec);
  }
  if (!opn_1st)
    if (prog_flag.add_cmt > 1)
    { indent();
      (void) printf("/* %s %s */\n", CMT_END, CMT_OPN_DFNS);
    }
  return rec;
}

/* dumps ldcinit annotation */

PRIVATE void
dmp_ldi_ant ()
{
  (void) printf("\n");
  indent();
  (void) printf("%s %s()", C_VOID, K_LDCINIT);
  if (ldi_ant == NULL)
  { (void) printf(" {}\n");
    return;
  }
  (void) printf("\n");
  indent();
  (void) printf("{\n");
  (void) printf("%s\n", ldi_ant);
  indent();
  (void) printf("}\n");
}

/* dumps ldc annotation (at the end) */

PRIVATE void
dmp_lde_ant ()
{
  if (lde_ant == NULL)
    return;
  (void) printf("\n");
  (void) printf("%s\n", lde_ant);
}

/* translation ending */

PRIVATE sREC *
trn_end (rec)
  sREC *rec;
{
  abort_if(rec != NULL)
  dmp_ldi_ant();
  dmp_lde_ant();
  return rec;
}

/* writes program usage */

PRIVATE void
usage ()
{
  (void) fprintf(stderr, "usage: %s", prog_name);
  (void) fprintf(stderr, " [ -h ]");
  (void) fprintf(stderr, " [ -c[0-2] ]");
  (void) fprintf(stderr, " [ -i[num] ]");
  (void) fprintf(stderr, " [ [ -spieces ] -pprefix [ -C ] ]");
  (void) fprintf(stderr, " header");
  (void) fprintf(stderr, "\n");
}

/* writes program help */

PRIVATE void
help ()
{
  usage();
  (void) fprintf(stderr, "       -h        this help message\n");
  (void) fprintf(stderr, "       -c[0-2]   comment insertion level ");
  (void) fprintf(stderr, "(default 1)\n");
  (void) fprintf(stderr, "       -i[num]   indentation level size ");
  (void) fprintf(stderr, "(range 0-%u, default %u)\n",
		 MAX_INDT_INCR, DFL_INDT_INCR);
  (void) fprintf(stderr, "       -spieces  splits in pieces ");
  (void) fprintf(stderr, "(range %u-%u)\n",
		 MIN_SPLT_PICS, MAX_SPLT_PICS);
  (void) fprintf(stderr, "       -pprefix  splitting prefix\n");
  (void) fprintf(stderr, "       -C        full cleaning\n");
  (void) fprintf(stderr, "       header    header file\n");
}

/* processes command line arguments */

PRIVATE void
proc_arg (argc, argv)
  int argc;
  char *argv[];
{
  int any_error= FALSE;
  int i, j;

  prog_name= strrchr(argv[0], '/');
  if (prog_name == NULL)
    prog_name= argv[0];
  else
    ++prog_name;
  for (i= 1; !any_error && i < argc; ++i)
    if (argv[i][j= 0] == '-')
      switch (argv[i][++j])
      { case 'h':
	  prog_flag.put_help= TRUE;
	  if (argv[i][++j] != '\0')
	    any_error= TRUE;
	  break;
	case 'c':
	{ int argcnt;
	  unsigned value;
	  char end;

	  argcnt= sscanf(&argv[i][++j], "%u %c", &value, &end);
	  if (argcnt == EOF)
	    prog_flag.add_cmt= 1;
	  else if (argcnt == 1 && value <= 2)
	    prog_flag.add_cmt= value;
	  else
	    any_error= TRUE;
	  break;
	}
	case 'i':
	{ int argcnt;
	  unsigned value;
	  char end;

	  argcnt= sscanf(&argv[i][++j], "%u %c", &value, &end);
	  if (argcnt == EOF)
	    prog_flag.indt_incr= DFL_INDT_INCR;
	  else if (argcnt == 1 && value <= MAX_INDT_INCR)
	    prog_flag.indt_incr= value;
	  else
	    any_error= TRUE;
	  break;
	}
	case 's':
	{ int argcnt;
	  unsigned value;
	  char end;

	  argcnt= sscanf(&argv[i][++j], "%u %c", &value, &end);
	  if (argcnt == 1 &&
	      value >= MIN_SPLT_PICS &&
	      value <= MAX_SPLT_PICS)
	    prog_flag.splt_pics= value;
	  else
	    any_error= TRUE;
	  break;
	}
	case 'p':
	  if (argv[i][++j] == '\0')
	    any_error= TRUE;
	  else
	    prog_flag.splt_prfx= &argv[i][j];
	  break;
	case 'C':
	  prog_flag.full_clng= TRUE;
	  if (argv[i][++j] != '\0')
	    any_error= TRUE;
	  break;
	default:
	  any_error= TRUE;
	  break;
      }
    else if (prog_flag.hdr_file == NULL)
      prog_flag.hdr_file= argv[i];
    else
      any_error= TRUE;
  if (prog_flag.splt_prfx == NULL)
  { if (prog_flag.splt_pics != 0)
      any_error= TRUE;
    if (prog_flag.full_clng)
      any_error= TRUE;
  }
  else
  { if (prog_flag.splt_pics == 0)
      prog_flag.splt_pics= 1;
  }
  if (!prog_flag.put_help)
  { if (prog_flag.hdr_file == NULL)
      any_error= TRUE;
  }
  if (any_error)
  { usage();
    exit(2);
  }
  if (prog_flag.put_help)
  { help();
    exit(0);
  }
}

PUBLIC int
main (argc, argv)
  int argc;
  char *argv[];
{
  sREC *rec;

  proc_arg(argc, argv);
  if (prog_flag.full_clng)
  { int pic;

    (void) unlink(prog_flag.hdr_file);
    for (pic= 0; pic < prog_flag.splt_pics; ++pic)
      (void) unlink(splt_file(pic));
    exit(0);
  }
  rec= trn_init();
  rec= skp_ldc_ant(rec);
  rec= trn_ldi_ant(rec);
  rec= trn_lde_ant(rec);
  rec= trn_srt_dcls(rec);
  rec= trn_opn_dcls(rec);
  rec= trn_opn_dfns(rec);
  rec= trn_end(rec);
  exit(0);
  return 0;
}
