/***********************************************************************
     "d2ada_b.o": lotos Data language to ADA Body.
***********************************************************************/

/***********************************
  (C) Copyright 1993; dit/upm
   Distributed under the conditions stated in the
   TOPO General Public License (see file LICENSE)
 ***********************************
 $Log: d2ada_b.c,v $
 * Revision 3.7  1995/01/17  09:57:44  lotos
 * dynamic table sizing
 *
 * Revision 3.6  1994/12/19  15:15:30  lotos
 * new convention for pieces
 *
 * Revision 3.5  1994/07/18  17:55:33  lotos
 * Adapted to GNAT compiler
 *
 * Revision 3.4  1993/06/10  14:06:29  lotos
 * new annotation CALL
 *
 * Revision 3.3  1993/06/01  13:36:57  lotos
 * error cuando las tablas tenian tamano 1
 *
 * Revision 3.2  1993/05/28  10:58:04  lotos
 * comentarios por niveles
 * la anotacion ldcinit ya no se soporta
 * tablas de sort y operaciones empiezan en 1, y no tienen huecos
 *
 * Revision 3.1  1993/05/25  11:08:41  lotos
 * complete remake
 *
 * Revision 2.1  91/07/11  14:16:34  lotos
 * using alga
 *
 ***********************************/

#include "version.h"
#ifndef lint
static char rcsid[]= "$Id: d2ada_b.c,v 3.7 1995/01/17 09:57:44 lotos Exp $";
#endif

#define d2ada_b_IMP

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include "d2ada_b.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);
  }
  else
  { p+= strlen(p);
    (void) strcpy(p, "_b");
  }
  p+= strlen(p);
  (void) strcpy(p, ".a");
  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);
  }
}

/* translation initialization */

PRIVATE sREC *
trn_init ()
{
  if (prog_flag.splt_pics != 0)
    new_splt_file();
  init_indt(prog_flag.indt_incr);
  ign_empty_rec= TRUE;
  return get_rec();
}

/* to storage ldc annotation (at the beginning) */
PRIVATE char *ldc_ant= NULL;

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

PRIVATE int
dmp_ldc_ant ()
{
  if (ldc_ant == NULL)
    return FALSE;
  (void) printf("%s\n", ldc_ant);
  return TRUE;
}

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

PRIVATE sREC *
trn_ldc_ant (rec)
  sREC *rec;
{
  char *ldc_line;

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

/* skips ldcinit annotation */

PRIVATE sREC *
skp_ldi_ant (rec)
  sREC *rec;
{
  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  if (field(rec, 1, SYM) != BEGIN_ANNOTATION ||
      field(rec, 2, SYM) != LDCINIT_ANNOTATION)
    return rec;
  error("ldcinit annotation not implemented");
  while (rec= get_rec(),
	 field(rec, 1, SYM) != END_ANNOTATION)
    continue;
  return get_rec();
}

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

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

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

/* 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));			\
	}

/* prints a close bracket */

#define close_bracket(chr)				\
	{						\
	  (void) printf("%c", (chr));			\
	}

/* starts to print a table entry */

#define start_tbl_entry()				\
	{						\
	  if (prog_flag.add_cmt > 1)			\
	    advc_indt(0, 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(')');				\
	}

/* to storage sort declarations */
PRIVATE int max_srt= -1;
PRIVATE sREC **srt_dcl= NULL;
PRIVATE char **cmt_srt_dcl= NULL;
PRIVATE char **free_srt_dcl= NULL;
PRIVATE char **equal_srt_dcl= NULL;
PRIVATE char **draw_srt_dcl= NULL;
PRIVATE char **parse_srt_dcl= NULL;

/* dumps free table */

PRIVATE void
dmp_free_tbl ()
{
  sREC *srt_info;
  char *srt_cmt;
  char *srt_free;
  int i;

  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_BEGIN, CMT_FREE_TBL);
  }
  indent();
  (void) printf("%s %s(%s: %s; %s: %s) %s\n",
		A_PROCEDURE, K_FREE_TBL,
		K_SORT, A_INTEGER, K_EXP, U_DATUM, A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s %s %s\n", A_CASE, K_SORT, A_IS);
  incr_indt(DFLT_INDT);
  for (i= 1; 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];
    if (srt_free == NULL)
      continue;
    indent();
    (void) printf("%s %d =>", A_WHEN, -field(srt_info, 3, INT));
    if (srt_cmt != NULL)
      (void) printf(" -- %s", srt_cmt);
    (void) printf("\n");
    incr_indt(DFLT_INDT);
    indent();
    (void) printf("%s(%s);\n", srt_free, K_EXP);
    decr_indt();
  }
  indent();
  (void) printf("%s %s => %s;\n", A_WHEN, A_OTHERS, A_NULL);
  decr_indt();
  indent();
  (void) printf("%s;\n", A_ENDCASE);
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_FREE_TBL);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_FREE_TBL);
  }
}

/* dumps equal table */

PRIVATE void
dmp_equal_tbl ()
{
  sREC *srt_info;
  char *srt_cmt;
  char *srt_equal;
  int i;

  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_BEGIN, CMT_EQUAL_TBL);
  }
  indent();
  (void) printf("%s %s(%s: %s; %s1, %s2: %s) %s %s %s\n",
		A_FUNCTION, K_EQUAL_TBL,
		K_SORT, A_INTEGER, K_EXP, K_EXP, U_DATUM,
		A_RETURN, A_BOOLEAN, A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s %s %s\n", A_CASE, K_SORT, A_IS);
  incr_indt(DFLT_INDT);
  for (i= 1; i <= max_srt; ++i)
  { srt_info= srt_dcl[i];
    srt_cmt= prog_flag.add_cmt > 1? cmt_srt_dcl[i]: NULL;
    srt_equal= equal_srt_dcl[i];
    if (srt_equal == NULL)
      continue;
    indent();
    (void) printf("%s %d =>", A_WHEN, -field(srt_info, 3, INT));
    if (srt_cmt != NULL)
      (void) printf(" -- %s", srt_cmt);
    (void) printf("\n");
    incr_indt(DFLT_INDT);
    indent();
    (void) printf("%s %s(%s1, %s2);\n", A_RETURN, srt_equal, K_EXP, K_EXP);
    decr_indt();
  }
  indent();
  (void) printf("%s %s => %s %s;\n", A_WHEN, A_OTHERS, A_RETURN, A_FALSE);
  decr_indt();
  indent();
  (void) printf("%s;\n", A_ENDCASE);
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_EQUAL_TBL);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_EQUAL_TBL);
  }
}

/* dumps draw table */

PRIVATE void
dmp_draw_tbl ()
{
  sREC *srt_info;
  char *srt_cmt;
  char *srt_draw;
  int i;

  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_BEGIN, CMT_DRAW_TBL);
  }
  indent();
  (void) printf("%s %s(%s: %s; %s: %s) %s %s %s\n",
		A_FUNCTION, K_DRAW_TBL,
		K_SORT, A_INTEGER, K_EXP, U_DATUM,
		A_RETURN, A_STRING, A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s %s %s\n", A_CASE, K_SORT, A_IS);
  incr_indt(DFLT_INDT);
  for (i= 1; i <= max_srt; ++i)
  { srt_info= srt_dcl[i];
    srt_cmt= prog_flag.add_cmt > 1? cmt_srt_dcl[i]: NULL;
    srt_draw= draw_srt_dcl[i];
    if (srt_draw == NULL)
      continue;
    indent();
    (void) printf("%s %d =>", A_WHEN, -field(srt_info, 3, INT));
    if (srt_cmt != NULL)
      (void) printf(" -- %s", srt_cmt);
    (void) printf("\n");
    incr_indt(DFLT_INDT);
    indent();
    (void) printf("%s %s(%s);\n", A_RETURN, srt_draw, K_EXP);
    decr_indt();
  }
  indent();
  (void) printf("%s %s => %s \"\";\n", A_WHEN, A_OTHERS, A_RETURN);
  decr_indt();
  indent();
  (void) printf("%s;\n", A_ENDCASE);
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_DRAW_TBL);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_DRAW_TBL);
  }
}

/* dumps parse table */

PRIVATE void
dmp_parse_tbl ()
{
  sREC *srt_info;
  char *srt_cmt;
  char *srt_parse;
  int i;

  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_BEGIN, CMT_PARSE_TBL);
  }
  indent();
  (void) printf("%s %s(%s: %s; %s: %s; %s: %s %s %s; %s: %s %s; %s: %s %s) %s\n",
		A_PROCEDURE, K_PARSE_TBL,
		K_SORT, A_INTEGER, K_STR, A_STRING,
		K_NDX, A_IN, A_OUT, A_INTEGER, K_VAL, A_OUT, U_DATUM,
		K_OK, A_OUT, A_BOOLEAN, A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s %s %s\n", A_CASE, K_SORT, A_IS);
  incr_indt(DFLT_INDT);
  for (i= 1; i <= max_srt; ++i)
  { srt_info= srt_dcl[i];
    srt_cmt= prog_flag.add_cmt > 1? cmt_srt_dcl[i]: NULL;
    srt_parse= parse_srt_dcl[i];
    if (srt_parse == NULL)
      continue;
    indent();
    (void) printf("%s %d =>", A_WHEN, -field(srt_info, 3, INT));
    if (srt_cmt != NULL)
      (void) printf(" -- %s", srt_cmt);
    (void) printf("\n");
    incr_indt(DFLT_INDT);
    indent();
    (void) printf("%s(%s, %s, %s, %s);\n",
		  srt_parse, K_STR, K_NDX, K_VAL, K_OK);
    decr_indt();
  }
  indent();
  (void) printf("%s %s => %s:= %s;\n", A_WHEN, A_OTHERS, K_OK, A_FALSE);
  decr_indt();
  indent();
  (void) printf("%s;\n", A_ENDCASE);
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_PARSE_TBL);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_PARSE_TBL);
  }
}

/* dumps sort table */

PRIVATE void
dmp_sort_tbl ()
{
  sREC *srt_info;
  char *srt_cmt;
  int i;

  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_BEGIN, CMT_SORT_TBL);
  }
  indent();
  (void) printf("%s %s %s %s %s\n",
		A_FUNCTION, K_SORT_TBL_INIT,
		A_RETURN, K_TYPE_SORT_TBL, A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  if (max_srt == 0)
    (void) printf("%s %s %s(1..0)", A_RETURN, A_NEW, K_TYPE_SORT_MTX);
  else
  { advc_indt(0, FILL, "%s %s %s'", A_RETURN, A_NEW, K_TYPE_SORT_MTX);
    advc_indt(0, FILL, "(");
    if (max_srt == 1)
      advc_indt(0, FILL, "1 => ");
  }
  for (i= 1; i <= max_srt; ++i)
  { srt_info= srt_dcl[i];
    srt_cmt= prog_flag.add_cmt > 1? cmt_srt_dcl[i]: NULL;
    if (i > 1)
    { (void) printf(",\n");
      indent();
    }
    abort_if(srt_info == NULL)
    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? A_FALSE:
							    A_TRUE);
    next_tbl_key(K_NAME);
    (void) printf("%s %s'(\"%s\")",
		  A_NEW, A_STRING, sym_name(field(srt_info, 4, SYM)));
    finish_tbl_entry();
  }
  if (max_srt == 0)
    (void) printf(";\n");
  else
  { (void) printf("\n");
    if (max_srt == 1)
      decr_indt();
    decr_indt();
    indent();
    (void) printf(");\n");
    decr_indt();
  }
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_SORT_TBL_INIT);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_SORT_TBL);
  }
}

/* translates sort declarations */

PRIVATE sREC *
trn_srt_dcls (rec)
  sREC *rec;
{
  int srt_uid;
  char *srt_cmt= NULL;
  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(srt_uid <= 0 ||
		 srt_uid > max_srt)
	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;
  }
  return get_rec();
}

/* to storage operation declarations */
PRIVATE int max_opn= -1;
PRIVATE char **cmt_opn_dcl= NULL;
PRIVATE sREC **opn_dcl= NULL;
PRIVATE char **call_opn_dcl= NULL;

/* dumps eval table */

PRIVATE void
dmp_eval_tbl ()
{
  int arg_inc;
  sREC *srt_info;
  sREC *opn_info;
  char *opn_cmt;
  int i, j;

  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_BEGIN, CMT_EVAL_TBL);
  }
  indent();
  (void) printf("%s %s(%s: %s; %s: %s) %s %s %s\n",
		A_FUNCTION, K_EVAL_TBL, K_OPN, A_INTEGER,
		K_ARG_MTX, K_TYPE_ARG_MTX, A_RETURN, K_DATUM, A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s %s %s\n", A_CASE, K_OPN, A_IS);
  incr_indt(DFLT_INDT);
  for (j= 1; 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);
    indent();
    (void) printf("%s %d =>", A_WHEN, field(opn_info, 3, INT));
    if (opn_cmt != NULL)
      (void) printf(" -- %s", opn_cmt);
    (void) printf("\n");
    incr_indt(DFLT_INDT);
    indent();
    (void) printf("%s %s(%s", A_RETURN, K_FDATUM,
		  sym_name(field(opn_info, 2, SYM)));
    if (arg_inc > 0)
    { (void) printf("(");
      i= 1;
      for (;;)
      { srt_info= srt_dcl[-field(opn_info, 7 + i, INT)];
	if (field(srt_info, 5, SYM) == DEFINED)
	  (void) printf("%s", K_FDATUM);
	else
	  (void) printf("%s", U_FDATUM);
	(void) printf("(%s(%d))", K_ARG_MTX, i);
	if (i++ == arg_inc)
	  break;
	(void) printf(", ");
      }
      (void) printf(")");
    }
    (void) printf(");\n");
    decr_indt();
  }
  indent();
  (void) printf("%s %s => %s %s;\n", A_WHEN, A_OTHERS, A_RETURN, A_NULL);
  decr_indt();
  indent();
  (void) printf("%s;\n", A_ENDCASE);
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_EVAL_TBL);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_EVAL_TBL);
  }
}

/* dumps operation table */

PRIVATE void
dmp_opn_tbl ()
{
  int arg_inc;
  sREC *opn_info;
  char *opn_cmt;
  int i, imax, j;

  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_BEGIN, CMT_OPN_TBL);
  }
  indent();
  (void) printf("%s %s %s %s %s\n",
		A_FUNCTION, K_OPN_TBL_INIT,
		A_RETURN, K_TYPE_OPN_TBL, A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  if (max_opn == 0)
    (void) printf("%s %s %s(1..0)", A_RETURN, A_NEW, K_TYPE_OPN_MTX);
  else
  { advc_indt(0, FILL, "%s %s %s'", A_RETURN, A_NEW, K_TYPE_OPN_MTX);
    advc_indt(0, FILL, "(");
    if (max_opn == 1)
      advc_indt(0, FILL, "1 => ");
  }
  for (j= 1; j <= max_opn; ++j)
  { opn_info= opn_dcl[j];
    opn_cmt= prog_flag.add_cmt > 1? cmt_opn_dcl[j]: NULL;
    if (j > 1)
    { (void) printf(",\n");
      indent();
    }
    abort_if(opn_info == NULL)
    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_SARG);
    (void) printf("%s %s", A_NEW, K_TYPE_SARG_MTX);
    if (arg_inc == 0)
      (void) printf("(1..0)");
    else
    { (void) printf("'(");
      if (arg_inc == 1)
	(void) printf("1 => ");
      i= 8;
      imax= i + arg_inc;
      for (;;)
      { (void) printf("%d", -field(opn_info, i, INT));
	if (++i == imax)
	  break;
	(void) printf(", ");
      }
      (void) printf(")");
    }
    next_tbl_key(K_ISEXTERN);
    (void) printf("%s", field(opn_info, 5, SYM) == DEFINED? A_FALSE:
							    A_TRUE);
    next_tbl_key(K_ISINFIX);
    (void) printf("%s", A_FALSE);
    next_tbl_key(K_NAME);
    (void) printf("%s %s'(\"%s\")",
		  A_NEW, A_STRING, sym_name(field(opn_info, 4, SYM)));
    finish_tbl_entry();
  }
  if (max_opn == 0)
    (void) printf(";\n");
  else
  { (void) printf("\n");
    if (max_opn == 1)
      decr_indt();
    decr_indt();
    indent();
    (void) printf(");\n");
    decr_indt();
  }
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_OPN_TBL_INIT);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_OPN_TBL);
  }
}

/* dumps constant storage */

PRIVATE int
dmp_cns_stg ()
{
  int cns_1st= TRUE;
  sREC *opn_info;
  char *opn_cmt;
  int sort;
  int i;

  for (i= 1; i <= max_opn; ++i)
  { opn_info= opn_dcl[i];
    opn_cmt= prog_flag.add_cmt > 1? cmt_opn_dcl[i]: NULL;
    if (opn_info == NULL)
      continue;
    if (field(opn_info, 5, SYM) != DEFINED)
      continue;
    if (field(opn_info, 7, INT) > 0)
      continue;
    if (cns_1st)
    { if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("-- %s %s --\n", CMT_BEGIN, CMT_CNS_STG);
      }
      indent();
      (void) printf("%s %s %s\n", A_PACKAGE, CNS_STG, A_IS);
      incr_indt(DFLT_INDT);
      cns_1st= FALSE;
    }
    else if (prog_flag.add_cmt > 1)
      (void) printf("\n");
    indent();
    if (opn_cmt != NULL)
    { (void) printf("-- %s\n", opn_cmt);
      indent();
    }
    (void) printf("%s %s %s %s %s(",
		  A_PACKAGE, sym_name(field(opn_info, 2, SYM)),
		  A_IS, A_NEW, K_KONST);
    sort= -field(opn_info, 6, INT);
    if (field(srt_dcl[sort], 5, SYM) == DEFINED)
      (void) printf("%s", K_DATUM);
    else
      (void) printf("%s", U_DATUM);
    (void) printf(");\n");
  }
  if (cns_1st)
    return FALSE;
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, CNS_STG);
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_CNS_STG);
  }
  return TRUE;
}

/* dumps external call definitions */

PRIVATE int
dmp_call_dfns ()
{
  int call_1st= TRUE;
  sREC *opn_info;
  char *opn_cmt;
  char *opn_call;
  char *opn_name;
  int sort;
  int args;
  int max_args= 0;
  int *sarg= NULL;
  int i, j;

  for (j= 1; j <= max_opn; ++j)
  { opn_info= opn_dcl[j];
    opn_cmt= prog_flag.add_cmt > 0? cmt_opn_dcl[j]: NULL;
    opn_call= call_opn_dcl[j];
    if (opn_info == NULL)
      continue;
    if (opn_call == NULL)
      continue;
    if (call_1st)
    { if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("-- %s %s --\n", CMT_BEGIN, CMT_CALL_DFNS);
      }
      call_1st= FALSE;
    }
    else
      (void) printf("\n");
    if (opn_cmt != NULL)
    { indent();
      (void) printf("-- %s\n", opn_cmt);
    }
    opn_name= sym_name(field(opn_info, 2, SYM));
    sort= -field(opn_info, 6, INT);
    args= field(opn_info, 7, INT);
    if (args > max_args)
    { max_args= args;
      if (sarg == NULL)
	talloc(sarg, max_args);
      else
	trealloc(sarg, max_args);
    }
    for (i= 0; i < args; ++i)
      sarg[i]= -field(opn_info, 8 + i, INT);
    indent();
    (void) printf("%s %s", A_FUNCTION, opn_name);
    if (args > 0)
    { (void) printf("(");
      for (i= 1;; ++i)
      { (void) printf("%s%d: ", ARG_ROOT, i);
	if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
	  (void) printf("%s", K_DATUM);
	else
	  (void) printf("%s", U_DATUM);
	if (i == args)
	  break;
	(void) printf("; ");
      }
      (void) printf(")");
    }
    (void) printf(" %s ", A_RETURN);
    if (field(srt_dcl[sort], 5, SYM) == DEFINED)
      (void) printf("%s", K_DATUM);
    else
      (void) printf("%s", U_DATUM);
    (void) printf(" %s\n", A_IS);
    if (args > 0)
    { incr_indt(DFLT_INDT);
      indent();
      (void) printf("%s: ", VAL_NAME);
      if (field(srt_dcl[sort], 5, SYM) == DEFINED)
	(void) printf("%s", K_DATUM);
      else
	(void) printf("%s", U_DATUM);
      (void) printf(";\n");
      decr_indt();
    }
    indent();
    (void) printf("%s\n", A_BEGIN);
    incr_indt(DFLT_INDT);
    if (args == 0)
    { indent();
      (void) printf("%s ", A_RETURN);
    }
    else
    { indent();
      (void) printf("%s:= ", VAL_NAME);
    }
    {
      char *p, *q, *r;

      for (p= opn_call; (q= strchr(p, '$')) != NULL; p= q)
      { (void) printf("%.*s", q - p, p);
	if (*(q + 1) == '$')
	{ (void) printf("$");
	  q+= 2;
	}
	else
	{ if (q > opn_call && isascii(*(q - 1)) &&
	      (isalnum(*(q - 1)) || *(q - 1) == '_'))
	    (void) printf(" ");
	  for (r= ++q; isascii(*r) && isdigit(*r); ++r)
	    ;
	  abort_if(r == q)
	  i= atoi(q);
	  abort_if(i <= 0 || i > args)
	  if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
	    (void) printf("%s(", K_FCOPY);
	  else
	    (void) printf("%s(%d, ", U_FCOPY, sarg[i - 1]);
	  (void) printf("%s", ARG_ROOT);
	  (void) printf("%.*s)", r - q, q);
	  if (*r != '\0' && isascii(*r) &&
	      (isalnum(*r) || *r == '_'))
	    (void) printf(" ");
	  q= r;
	}
      }
      (void) printf("%s", p);
    }
    (void) printf(";\n");
    if (args > 0)
    { for (i= 1; i <= args; ++i)
      { indent();
	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);
      }
      indent();
      (void) printf("%s %s;\n", A_RETURN, VAL_NAME);
    }
    decr_indt();
    indent();
    (void) printf("%s %s;\n", A_END, opn_name);
  }
  if (call_1st)
    return FALSE;
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_CALL_DFNS);
  }
  if (sarg != NULL)
  { tfree(sarg);
    max_args= 0;
    sarg= NULL;
  }
  return TRUE;
}

/* dumps operations stubs for splitting */

PRIVATE int
dmp_opn_splt ()
{
  int opn_1st= TRUE;
  sREC *opn_info;
  char *opn_cmt;
  char *opn_name;
  int sort;
  int args;
  int max_args= 0;
  int *sarg= NULL;
  int i, j;

  for (j= 1; 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;
    if (field(opn_info, 5, SYM) != DEFINED)
      continue;
    if (opn_1st)
    { if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("-- %s %s --\n", CMT_BEGIN, CMT_OPN_STBS);
      }
      opn_1st= FALSE;
    }
    else if (prog_flag.add_cmt > 1)
      (void) printf("\n");
    opn_name= sym_name(field(opn_info, 2, SYM));
    sort= -field(opn_info, 6, INT);
    args= field(opn_info, 7, INT);
    if (args > max_args)
    { max_args= args;
      if (sarg == NULL)
	talloc(sarg, max_args);
      else
	trealloc(sarg, max_args);
    }
    for (i= 0; i < args; ++i)
      sarg[i]= -field(opn_info, 8 + i, INT);
    indent();
    if (opn_cmt != NULL)
    { (void) printf("-- %s\n", opn_cmt);
      indent();
    }
    (void) printf("%s %s", A_FUNCTION, opn_name);
    if (args > 0)
    { (void) printf("(");
      for (i= 1;; ++i)
      { (void) printf("%s%d: ", ARG_ROOT, i);
	if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
	  (void) printf("%s", K_DATUM);
	else
	  (void) printf("%s", U_DATUM);
	if (i == args)
	  break;
	(void) printf("; ");
      }
      (void) printf(")");
    }
    (void) printf(" %s ", A_RETURN);
    if (field(srt_dcl[sort], 5, SYM) == DEFINED)
      (void) printf("%s", K_DATUM);
    else
      (void) printf("%s", U_DATUM);
    (void) printf(" %s %s;\n", A_IS, A_SEPARATE);
  }
  if (opn_1st)
    return FALSE;
  if (prog_flag.add_cmt > 1)
  { indent();
    (void) printf("-- %s %s --\n", CMT_END, CMT_OPN_STBS);
  }
  if (sarg != NULL)
  { tfree(sarg);
    max_args= 0;
    sarg= NULL;
  }
  return TRUE;
}

/* translates operation declarations */

PRIVATE sREC *
trn_opn_dcls (rec)
  sREC *rec;
{
  int opn_uid;
  char *opn_cmt= NULL;
  int ant_type;
  char *ant_line, *ant_text;
  int i;

  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 (i= 0; i <= max_opn; ++i)
    cmt_opn_dcl[i]= NULL;
  abort_if(opn_dcl != NULL)
  talloc(opn_dcl, max_opn + 1);
  for (i= 0; i <= max_opn; ++i)
    opn_dcl[i]= NULL;
  abort_if(call_opn_dcl != NULL)
  talloc(call_opn_dcl, max_opn + 1);
  for (i= 0; i <= max_opn; ++i)
    call_opn_dcl[i]= NULL;
  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(opn_uid <= 0 ||
		 opn_uid > max_opn)
	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:
	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 CALL_ANNOTATION:
	    call_opn_dcl[opn_uid]= ant_text;
	    break;
	  default:
	    abort_if(TRUE)
	    break;
	}
	continue;
      case END_OPERATIONS_DECL:
	break;
      default:
	abort_if(TRUE)
	break;
    }
    break;
  }
  if (dmp_lde_ant())
    (void) printf("\n");
  indent();
  (void) printf("%s %s %s %s\n", A_PACKAGE, A_BODY, K_TABLE_DATA, A_IS);
  incr_indt(DFLT_INDT);
  dmp_sort_tbl();
  (void) printf("\n");
  dmp_opn_tbl();
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_TABLE_DATA);
  (void) printf("\n");
  (void) dmp_ldc_ant();
  indent();
  (void) printf("%s %s; %s %s;\n", A_WITH, PACK_NAME, A_USE, PACK_NAME);
  indent();
  (void) printf("%s %s %s %s\n", A_PACKAGE, A_BODY, K_TABLE_FUNC, A_IS);
  incr_indt(DFLT_INDT);
  dmp_free_tbl();
  (void) printf("\n");
  dmp_equal_tbl();
  (void) printf("\n");
  dmp_draw_tbl();
  (void) printf("\n");
  dmp_parse_tbl();
  (void) printf("\n");
  dmp_eval_tbl();
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, K_TABLE_FUNC);
  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)
	    indent();
	  (void) printf("%s %s (", A_IF, A_NOT);
	  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(") %s\n", A_THEN);
    incr_indt(DFLT_INDT);
    indent();
    (void) printf("%s(\"%s", K_PUT_ERROR, MSG_PTL_INTRO);
    (void) printf(": (%s %d %s \"\"%s\"\")\");\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", 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("\" & ");
      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 %s;\n", A_RAISE, A_PROGRAM_ERROR);
    decr_indt();
    indent();
    (void) printf("%s;\n", A_ENDIF);
    if (args == 0)
      indent();
    else
      (void) printf("\n");
  }
  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;
  int args;

  abort_if(rec == NULL ||
	   nofld(rec) == 0)
  switch (field(rec, 1, SYM))
  { case OPERATION_EVAL:
      args= field(rec, 3, INT);
      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 (args > 0)
	  (void) printf("(");
      }
      if (args > 0)
      { int i;

	for (i= args;;)
	{ wrt_exp(get_rec());
	  if (--i == 0)
	    break;
	  (void) printf(", ");
	}
      }
      if (equal_uid != 0)
      { (void) printf(", (%s, %s))", A_TRUE, A_TRUE);
	equal_uid= 0;
      }
      else if (args > 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_FDATUM);
      rec= get_rec();
      abort_if(field(rec, 1, SYM) != VALUE_EVAL)
      wrt_ref(rec);
      if (field(srt_dcl[sort], 5, SYM) == DEFINED)
	;
      else
	(void) printf(")");
      (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 ", A_IF);
	  else
	  { indent();
	    advc_indt(0, FILL, "%s ", A_ELSE_IF);
	  }
	}
	else
	{ (void) printf(" A_AND_THEN\n");
	  indent();
	}
	wrt_exp(get_rec());
	continue;
      case END_CONDITION:
	++cond_cnt;
	continue;
      case BEGIN_REPLACEMENT:
	if (cond_cnt > 0)
	{ (void) printf(" %s\n", A_THEN);
	  decr_indt();
	  incr_indt(DFLT_INDT);
	  indent();
	}
	else if (rule_cnt > 0)
	{ indent();
	  (void) printf("%s\n", A_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;
  static int max_nest= -1;
  static int inc_nest= BUFSIZ / sizeof(int);
  static int *nest_whl= NULL;
  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)
  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)
	{ if (cond_cnt > 0 || rule_cnt > 1)
	  { indent();
	    (void) printf("%s;\n", A_ENDIF);
	  }
	  for (; nest_cnt < nest_lvl; --nest_lvl)
	  { decr_indt();
	    if (nest_lvl > max_nest)
	    { int top_nest= max_nest;

	      do
		max_nest+= inc_nest;
	      while (nest_lvl > max_nest);
	      if (nest_whl == NULL)
		talloc(nest_whl, max_nest + 1);
	      else
		trealloc(nest_whl, max_nest + 1);
	      while (++top_nest <= max_nest)
		nest_whl[top_nest]= FALSE;
	    }
	    if (nest_whl[nest_lvl])
	      nest_whl[nest_lvl]= FALSE;
	    else
	    { indent();
	      (void) printf("%s %s => %s;\n", A_WHEN, A_OTHERS, A_NULL);
	    }
	    decr_indt();
	    indent();
	    (void) printf("%s;\n", A_ENDCASE);
	  }
	  if (finish)
	    break;
	  if (start)
	  { lbl_1st= TRUE;
	    start= FALSE;
	  }
	  else
	  { 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 ", A_CASE);
	    wrt_ref(rec);
	    (void) printf(".%s %s\n", K_OPN, A_IS);
	    incr_indt(DFLT_INDT);
	    indent();
	  }
	  else
	  { indent();
	    lbl_1st= TRUE;
	  }
	  if (field(rec, 1, SYM) == OPERATION_MATCH)
	    (void) printf("%s %d =>", A_WHEN, field(rec, 2, INT));
	  else
	  { (void) printf("%s %s =>", A_WHEN, A_OTHERS);
	    if (nest_cnt > max_nest)
	    { int top_nest= max_nest;

	      do
		max_nest+= inc_nest;
	      while (nest_cnt > max_nest);
	      if (nest_whl == NULL)
		talloc(nest_whl, max_nest + 1);
	      else
		trealloc(nest_whl, max_nest + 1);
	      while (++top_nest <= max_nest)
		nest_whl[top_nest]= FALSE;
	    }
	    nest_whl[nest_cnt]= TRUE;
	  }
	  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 ", A_IF);
	  else
	    advc_indt(0, FILL, "%s ", A_ELSE_IF);
	}
	else
	{ (void) printf(" %s\n", A_AND_THEN);
	  indent();
	}
	wrt_exp(get_rec());
	continue;
      case END_CONDITION:
	++cond_cnt;
	continue;
      case BEGIN_REPLACEMENT:
	if (cond_cnt > 0)
	{ (void) printf(" %s\n", A_THEN);
	  decr_indt();
	  incr_indt(DFLT_INDT);
	}
	else if (rule_cnt > 0)
	{ indent();
	  (void) printf("%s\n", A_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", 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",
		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("\" & ");
    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 %s;\n", A_RAISE, A_PROGRAM_ERROR);
}

/* 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_FDATUM, 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", A_ELSE);
    incr_indt(DFLT_INDT);
    indent();
  }
  if (nofld(rec) > 3)
    wrt_bfl(rec, 0, (int *)NULL);
  else
    wrt_bld(rec, 0);
  if (has_rules)
  { decr_indt();
    indent();
    (void) printf("%s;\n", A_ENDIF);
  }
  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)
  if (has_rules)
  { (void) printf("\n");
    indent();
    (void) printf("%s %s = %s %s\n", A_IF, VAL_NAME, A_NULL, A_THEN);
    incr_indt(DFLT_INDT);
  }
  indent();
  if (nofld(rec) > 3)
    wrt_bfl(rec, args, sarg);
  else
    wrt_bld(rec, args);
  if (has_rules)
    decr_indt();
  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();
  (void) printf("%s %s %s ", A_FUNCTION, cns_name, A_RETURN);
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  (void) printf(" %s\n", A_IS);
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s %s.%s.%s %s\n",
		A_IF, CNS_STG, cns_name, K_FIRST, A_THEN);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s\n", A_DECLARE);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s: ", VAL_NAME);
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  (void) printf(";\n");
  decr_indt();
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  indent();
  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.%s.%s:= ", CNS_STG, cns_name, K_VALUE);
  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);
  indent();
  (void) printf("%s.%s.%s;\n", CNS_STG, cns_name, K_DONE);
  decr_indt();
  indent();
  (void) printf("%s;\n", A_END);
  decr_indt();
  indent();
  (void) printf("%s;\n", A_ENDIF);
  indent();
  (void) printf("%s %s.%s.%s;\n",
		A_RETURN, CNS_STG, cns_name, K_VALUE);
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, cns_name);
  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();
  (void) printf("%s %s(", A_FUNCTION, opn_name);
  for (i= 1;; ++i)
  { (void) printf("%s%d: ", ARG_ROOT, i);
    if (field(srt_dcl[sarg[i - 1]], 5, SYM) == DEFINED)
      (void) printf("%s", K_DATUM);
    else
      (void) printf("%s", U_DATUM);
    if (i == args)
      break;
    (void) printf("; ");
  }
  (void) printf(") %s ", A_RETURN);
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  (void) printf(" %s\n", A_IS);
  incr_indt(DFLT_INDT);
  indent();
  (void) printf("%s: ", VAL_NAME);
  if (field(srt_dcl[sort], 5, SYM) == DEFINED)
    (void) printf("%s", K_DATUM);
  else
    (void) printf("%s", U_DATUM);
  if (has_rules && has_build)
    (void) printf(":= %s", A_NULL);
  (void) printf(";\n");
  if (has_build)
  { indent();
    (void) printf("%s1", LNK_ROOT);
    if (args > 1)
      (void) printf(", %s2", LNK_ROOT);
    (void) printf(": %s", K_LINK);
    (void) printf(";\n");
  }
  decr_indt();
  indent();
  (void) printf("%s\n", A_BEGIN);
  incr_indt(DFLT_INDT);
  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", A_ELSE);
      incr_indt(DFLT_INDT);
      indent();
    }
    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("%s;\n", A_ENDIF);
    }
  }
  (void) printf("\n");
  indent();
  (void) printf("%s %s;\n", A_RETURN, VAL_NAME);
  decr_indt();
  indent();
  (void) printf("%s %s;\n", A_END, opn_name);
  tfree(sarg);
  return get_rec();
}

/* starts a new splitting atom (returns TRUE when new piece) */

PRIVATE int
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 };
  int new_pic= FALSE;

  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();
    new_pic= TRUE;
  }
  ++atom.cnt;
  return new_pic;
}

/* translates operation definitions */

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

  for (;;)
  { if (rec == NULL)
      break;
    if (field(rec, 1, SYM) != COMMENT &&
	field(rec, 1, SYM) != BEGIN_OPERATION_DEF)
      break;
    if (opn_1st)
    { (void) printf("\n");
      (void) dmp_ldc_ant();
      indent();
      (void) printf("%s %s %s %s\n", A_PACKAGE, A_BODY, PACK_NAME, A_IS);
      incr_indt(DFLT_INDT);
      if (dmp_cns_stg())
	(void) printf("\n");
      if (dmp_call_dfns())
	(void) printf("\n");
      if (prog_flag.splt_pics > 1)
      { (void) dmp_opn_splt();
	decr_indt();
	indent();
	(void) printf("%s %s;\n", A_END, PACK_NAME);
      }
    }
    if (prog_flag.splt_pics != 0)
      new_pic= new_splt_atom();
    if (opn_1st)
    { if (prog_flag.splt_pics > 1 && !new_pic)
	(void) printf("\n");
      if (prog_flag.add_cmt > 1)
      { indent();
	(void) printf("-- %s %s --\n", CMT_BEGIN, CMT_OPN_DFNS);
      }
      opn_1st= FALSE;
    }
    else if (!new_pic)
      (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 (prog_flag.splt_pics > 1)
    { indent();
      (void) printf("%s (%s)\n", A_SEPARATE, PACK_NAME);
    }
    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);
    }
    if (prog_flag.splt_pics <= 1)
    { decr_indt();
      indent();
      (void) printf("%s %s;\n", A_END, PACK_NAME);
    }
  }
  return rec;
}

/* translation ending */

PRIVATE sREC *
trn_end (rec)
  sREC *rec;
{
  abort_if(rec != NULL)
  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 spec ] ]");
  (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, "       spec      Ada spec 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.spec_file == NULL)
      prog_flag.spec_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.full_clng)
    { if (prog_flag.spec_file == NULL)
	any_error= TRUE;
    }
    else if (prog_flag.spec_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.spec_file);
    for (pic= 0; pic < prog_flag.splt_pics; ++pic)
      (void) unlink(splt_file(pic));
    exit(0);
  }
  rec= trn_init();
  rec= trn_ldc_ant(rec);
  rec= skp_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;
}
