/***********************************
  (C) Copyright 1992-1993; dit/upm
  Distributed under the conditions stated in the
  TOPO General Public License (see file LICENSE)
 ***********************************
  $Log: lsa.c,v $
 * Revision 1.18  1994/12/19  16:54:10  lotos
 * fix file names
 *
 * Revision 1.17  1994/07/19  17:48:31  lotos
 * fix a bug with canonical data type name
 *
 * Revision 1.16  1993/04/29  09:24:20  lotos
 * generacion de tabla de anotaciones
 * .lsa -> .ls & .at -> .as  (for libraries)
 *
 * Revision 1.15  1993/01/18  18:09:04  lotos
 * fix finemame, .lcr, for ms-dos compatibility
 *
 * Revision 1.14  1993/01/12  20:19:14  lotos
 * portability issues
 *
 * Revision 1.13  1992/12/17  11:20:01  lotos
 * fix debugging options (a bug)
 *
 * Revision 1.12  1992/11/04  16:16:57  lotos
 * option -C to compact sorts and operations unique identifiers
 * when a data type in incorrectly declared, it is assumed to have no formal part
 *
 * Revision 1.11  1992/09/11  16:42:08  lotos
 * fix user interface: library specification
 *
 * Revision 1.10  1992/09/11  15:03:32  lotos
 * remove shared colours (into the colours.{h,c})
 * improve help
 *
 * Revision 1.9  1992/05/06  17:31:56  lotos
 * added new colour to help in CR generation stuff
 * more debugging flags
 *
 * Revision 1.8  92/03/13  19:57:24  lotos
 * bug fix for CR generation
 *
 * Revision 1.7  92/02/21  17:13:30  lotos
 * optimization of lists of operations, for speed up
 *
 * Revision 1.6  92/02/20  19:23:29  lotos
 * adjust scope passed to local definitions: gates and values
 *
 * Revision 1.5  92/01/22  20:00:04  lotos
 * fixed bug w.r.t. [semi]flattening functions
 *
 * Revision 1.4  92/01/14  15:23:31  lotos
 * distribution issues
 *
 * Revision 1.3  92/01/14  10:02:02  lotos
 * bug: new type for mktype
 *
 * Revision 1.2  92/01/13  16:26:27  lotos
 * thousands of small bugs
 *
 * Revision 1.1  92/01/07  16:05:36  lotos
 * Initial revision
 *
 ***********************************/

#ifndef lint
static char rcsid[]= "$Id: lsa.c,v 1.18 1994/12/19 16:54:10 lotos Exp $";
#endif

# include "swbus.h"
# include "grc.h"

/* KJT 20/01/23: added function prototypes */
PUBLIC int isformal (TNODE* type);

/**  main module  **/

int spec_unique  = 1;
int type_unique  = 1;
int proc_unique  = 1;
int sort_unique  = 1;
int fsort_unique = 1;
int opns_unique  = 1;
int fopns_unique = 1;
int gate_unique  = 1;
int vals_unique  = 1;
int act_unique   = 1;

INTlist gvf=NULL;
INTlist gof=NULL;
INTlist gsf=NULL;

FILE*   ofs;
FILE*   aofs;

FILE*   sfp;
FILE*   lfp;
FILE*   rfp;

int flagd= 0;
int flags= 0;
int flagf= 0;
int flagc= 0;
int flagi= 0;
int flagt= 0;
int flagL= 0;
int flagC= 0;

char*  trdecs;
char*  srdecs;
char*  ordecs;
char*  prdecs;
char*  srep;
char*  sgdef;
char*  sginj;
char*  ssnover;
char*  sopnover;
char*  vcollision;
char*  pcollision;
char*  gcollision;

ST*	LSTable=NULL;
AT*	CSTable=NULL;
AT*	LATable=NULL;


INTlist clex = NULL;


ST*     tspec;
AT*     ATable;
ATdata* data;

TNODE*  lib = NULL;

PRIVATE AT*  cmd ();
PRIVATE void llinc ();

/*****  private variables  *****/

PRIVATE int grntype_definition []={_type_definition_1,data_type_definition_1,0};
PRIVATE int grntype_identifier []={_type_identifier_1,0};
PRIVATE int grnp_expression    []={_p_expression_1,0};
PRIVATE int grnp_specification []={_p_specification_1,0};

PRIVATE char PREFIX[BUFSIZ];  /* prefix for every file */
PRIVATE char  sfile[BUFSIZ];  /* specification file */
PRIVATE char  lfile[BUFSIZ];  /* library file */
PRIVATE char  ofile[BUFSIZ];  /* output file  */
PRIVATE char aofile[BUFSIZ];  /* output file for Atable */
PRIVATE char alfile[BUFSIZ];  /* Atable of the library file */
PRIVATE char crfile[BUFSIZ];  /* semiflattened library types */

PRIVATE TIOCOLOURS iocolours [] = {
# include "colours.c"
	"scp",     c_scp,	NULL,	putscp,	NULL,	NULL,
	"replace", c_replace,   IO_IL,
	"vals",    c_vals,      IO_IL,
	"types",   c_types,     IO_IL,
	"ltypes",  c_ltypes,    IO_IL,
	"procs",   c_procs,     IO_IL,
	"lprocs",  c_lprocs,    IO_IL,
	"locals",  c_locals,    NULL,   putscp, NULL,   NULL,
	"opns",    c_opns,      IO_IL,
	"nopns",   c_nopns,     IO_IL,
	"nfopns",  c_nfopns,    IO_IL,
	"sorts",   c_sorts,     IO_IL,
	"nsorts",  c_nsorts,    IO_IL,
	"nfsorts", c_nfsorts,   IO_IL,
	"fsorts",  c_fsorts,    IO_IL,
	"fopns",   c_fopns,     IO_IL,
	"gs",      c_gs,        IO_IL,
	"go",      c_go,        IO_IL,
	"repsorts",c_repsorts,  IO_IL,
	"repopns", c_repopns,   IO_IL,
	"argl",    c_argl,      IO_IL,
	"gates",   c_gates,     IO_IL,
	"func",    c_func,      IO_IL,
	"inher",   c_inher,     IO_int,
	"poss",    c_poss,      IO_IL,
	"rposs",   c_rposs,     IO_IL,
	"gate",    c_gate,      IO_int,
	"question",c_question,  IO_int,
	"nar",     c_nar,       IO_int,
	"varsort", c_varsort,   IO_int,
	"oldexp",  c_oldexp,    NULL,   putexp, NULL,   NULL,
	"exp",     c_exp,       readexp,   putexp, NULL,   NULL,
	"addr",    c_addr,      IO_int,
	"class",   c_class,     IO_int,
	"F1",	   c_F1,	IO_IL,
	"S_F1",	   c_S_F1,	IO_IL,
	"FOP1",	   c_FOP1,	IO_IL,
	"OP_FOP1", c_OP_FOP1,	IO_IL,
	"F2",	   c_F2,	IO_IL,
	"S_F2",	   c_S_F2,	IO_IL,
	"FOP2",	   c_FOP2,	IO_IL,
	"OP_FOP2", c_OP_FOP2,	IO_IL,
	"tiddec",  c_tiddec,	IO_int,
	"tidref",  c_tidref,	IO_int,
	"deps",    c_deps,	IO_IL,
	"S1",      c_S1,	IO_IL,
	"OP1",     c_OP1,	IO_IL,
	"actren",  c_actren,    IO_int,
	"esid",    c_esid,      IO_int,
	"eoid",    c_eoid,      IO_int,
	"formal",  c_formal,    IO_int,
	"oformal", c_oformal,   IO_int,
	"ot",      c_ot,        IO_int,
	"rsorts",  c_rsorts,    IO_IL,
	"ropns",   c_ropns,     IO_IL,
	"isformal",c_isformal,  IO_int,
	"tline",   c_tline,     IO_I2,
	OTHERS
	};

/*****  private functions headers  *****/

void	rag    ();

/*****  private function bodies  *****/
PRIVATE void
help ()
{
(void) fprintf (stderr,
"Usage: lsa [-h] [-d] [-s] [-f] [-c] [-C] [-l <stdlib>] -p prefix <specification>\n");
(void) fprintf (stderr,
"       lsa -h              : this help\n");
(void) fprintf (stderr,
"       lsa -p prefix       : prefix for generated filenames\n");
(void) fprintf (stderr,
"       lsa -s              : Semi-flattening of ADTs\n");
(void) fprintf (stderr,
"       lsa -f              : full flattening of ADTs\n");
(void) fprintf (stderr,
"       lsa -c              : ADTs processed for CR generation\n");
(void) fprintf (stderr,
"       lsa -C              : Compact lists of sorts and operations\n");
(void) fprintf (stderr,
"                             The use of -f option is required\n");
(void) fprintf (stderr,
"       lsa -l <stdlib>     : use <stdlib> as LOTOS library\n");
(void) fprintf (stderr,
"       lsa -d              : debugging option\n");
(void) fprintf (stderr,
"                      -s -f -c are incompatible options       \n");
exit (1);
}

PRIVATE FILE*
efopen(file, mode, toolname)
     char* file;
     char* mode;
     char* toolname;
{
  FILE* fp;
  FILE* fopen();

  if ((fp= fopen (file, mode)) == NULL) {
    (void) fprintf (stderr,
		    "%s: cannot open file %s mode %s\n",
		    toolname, file, mode);
    exit (1);
  }
  return fp;
} /* end of efopen */

/*****  public functions  *****/

PUBLIC	int
main	(argc, argv)
     int	argc;
     char*	argv[];
{
  int	i;
  char c;
  TNODE* r;
  TNODE* type;
  TNODE* oldtype;
  TNODE* ntype;
  TNODE* prd;
  TNexp* exp;
  TNexp* nexp;
  TNexp* aux;
  TNODE* auxt;
  TNODE* tmp;
  TNODE* at;
  TNODE* atlib = NULL;
  TNODE* stypes;
  int    tid;
  FILE*  lafp;
  char*  oname;

  strcpy (sfile, "");
  strcpy (PREFIX, "");

  while (argc > 1) {
    if (argv[1][0] == '-') {
      c = argv[1][1];
      if ((c != 'd') && (argv[1][2] != '\0'))
	 help ();
      switch (c) {
	case 'l':
	  if (argv[2] == NULL)
	    help ();

	  (void) strcpy (lfile, argv[2]);
	  argc--;
	  argv++;
	  break;
	case 'd':
	  flagd++;
	  for (i=2; argv[1][i] == 'd'; i++)
	    flagd++;
	  if (argv[1][i] != '\0')
	    help ();
	  break;
	case 'f':
	  flagf=1;
	  break;
	case 'c':
	  flagc=1;
	  break;
	case 's':
	  flags=1;
	  break;
	case 'C':
	  flagC=1;
	  break;
	case 'p':
	  strcpy (PREFIX, argv[2]);
	  argc--;
	  argv++;
	  break;
	default:
	  help ();
      }
    }
    else (void) strcpy (sfile, argv[1]);
    argc--;
    argv++;
  }

  if (strlen (PREFIX) == 0) {
    fataler ("lsa: option '-p prefix' is mandatory");
    exit (1);
  }
  if (strlen (sfile) == 0) {
    fataler ("lsa: specification is mandatory");
    exit (1);
  }

  strcpy ( ofile, PREFIX);
  strcpy (aofile, PREFIX);
  strcpy (crfile, PREFIX);

  if (flags > 0) {
    strcat ( ofile, ".lss");
    strcat (aofile, ".ass");
  }
  else if (flagf > 0) {
    strcat ( ofile, ".lsf");
    strcat (aofile, ".asf");
  }
  else if (flagc > 0) {
    strcat ( ofile, ".lsc");
    strcat (aofile, ".asc");
  }
  else {
    strcat ( ofile, ".ls");
    strcat (aofile, ".as");
  }
  strcat (crfile, ".lcr");

  if ((flagC != 0) && (flagC != flagf)){
    fataler ("lsa: -C option requires -f option");
    exit (1);
  }

  cast_init (iocolours);
  sfp = efopen (sfile, "r", "lsa");
  r= restore(sfp);

  if (r -> type == tdata_type_definitions)
    flagL++;

  ofs = efopen (ofile, "w", "lsa");
  aofs= efopen (aofile,"w", "lsa");

  if (strlen (lfile) != 0){
    (void) strcpy (alfile, lfile);
    (void) strcat (alfile, ".as");
    (void) strcat (lfile, ".ls");

    lfp = efopen (lfile, "r", "lsa");
    lib = restore (lfp);
    lafp= efopen (alfile, "r", "lsa");
    atlib = restore (lafp);
    LSTable= (ST*) find_attr (c_ll, atlib)->value;
    LATable = (AT*) find_attr (c_at, atlib)->value;
  }


  tspec = (ST*) find_attr (c_ll, r)->value;
  tspec -> incr = 16;
  tspec -> class  = 1;

  grnl = (IAT*) find_attr (c_grnl, r)->value;
  grnl -> incr = 16;
  grnl -> class = 1;
  SymbolTable = (ST*) find_attr (c_ll, r)->value;
  SymbolTable->incr = 16;
  SymbolTable->class = 1;


  if (LSTable != NULL){
    llinc (atlib, lib, r, LATable);
    ATable= LATable;
  }else{
    ATable= ATcreate (SymbolTable->size/20, 16);
    i= ATinc(ATable);
    ATable->data[i].value0= (CLR_TYPE)10;
    ATable->data[i].value1= (CLR_TYPE)10;
    /* set_attr(c_at, r, (CLR_TYPE) ATable);*/
  }

  data   = ATable->data;

  befussy= TRUE;

  /* for andling executable comments */
  if (flagL > 0)
    CSTable = ATcreate (16, 16);
  else
    CSTable = cmd(r);

  rag(r);

  if (flagd < 2) {
    name2clr("types")	->cpy=NULL;
    name2clr("opns")	->cpy=NULL;
    name2clr("ropns")	->cpy=NULL;
    name2clr("sorts")	->cpy=NULL;
    name2clr("rsorts")	->cpy=NULL;
    name2clr("fsorts")	->cpy=NULL;
    name2clr("fopns")	->cpy=NULL;
    name2clr("inher")	->cpy=NULL;
    name2clr("poss")	->cpy=NULL;
    name2clr("rposs")	->cpy=NULL;
  }
  if (flagd < 3) {
    if (flagL == 0){
      name2clr("exp")	->cpy=NULL;
      name2clr("argl")	->cpy=NULL;
      name2clr("nar")	->cpy=NULL;
      name2clr("deps")	->cpy=NULL;
      name2clr("gate")	->cpy=NULL;
    }
    name2clr("addr")	->cpy=NULL;
    name2clr("scp")	->cpy=NULL;
    name2clr("replace")	->cpy=NULL;
    name2clr("vals")	->cpy=NULL;
    name2clr("ltypes")	->cpy=NULL;
    name2clr("procs")	->cpy=NULL;
    name2clr("locals")	->cpy=NULL;
    name2clr("lprocs")	->cpy=NULL;
    name2clr("nopns")	->cpy=NULL;
    name2clr("nfopns")	->cpy=NULL;
    name2clr("nsorts")	->cpy=NULL;
    name2clr("nfsorts")	->cpy=NULL;
    name2clr("gs")	->cpy=NULL;
    name2clr("go")	->cpy=NULL;
    name2clr("repsorts")->cpy=NULL;
    name2clr("repopns")	->cpy=NULL;
    name2clr("gates")	->cpy=NULL;
    name2clr("func")	->cpy=NULL;
    name2clr("question")->cpy=NULL;
    name2clr("varsort")	->cpy=NULL;
    name2clr("oldexp")	->cpy=NULL;
    name2clr("class")	->cpy=NULL;
    name2clr("F1")	->cpy=NULL;
    name2clr("S_F1")	->cpy=NULL;
    name2clr("FOP1")	->cpy=NULL;
    name2clr("OP_FOP1")	->cpy=NULL;
    name2clr("F2")	->cpy=NULL;
    name2clr("S_F2")	->cpy=NULL;
    name2clr("FOP2")	->cpy=NULL;
    name2clr("OP_FOP2")	->cpy=NULL;
    name2clr("tiddec")	->cpy=NULL;
    name2clr("tidref")	->cpy=NULL;
    name2clr("S1")	->cpy=NULL;
    name2clr("OP1")	->cpy=NULL;
    name2clr("actren")	->cpy=NULL;
    name2clr("esid")	->cpy=NULL;
    name2clr("eoid")	->cpy=NULL;
    name2clr("formal")	->cpy=NULL;
    name2clr("oformal")	->cpy=NULL;
    name2clr("tline")	->cpy=NULL;
  }

  if (((flagc)||(flags))&&(ragerrors == 0)){
    if (flagc)
      stypes = new_node (tdata_type_definitions);

    for (type = lksucc (r, ttype_definition, PREORDER); type != NULL;){
      exp = (TNexp*) find_attr (c_exp, type)->value;

      ntype = mktype (exp, FALSE, type);
      if (flagc){
	if (isformal (type)){
	  set_attr (c_isformal, ntype, (CLR_TYPE)0);
	}
	cut_tree(ntype);
	(void)lnsons (stypes, ntype);
	type = lksucc (type, ttype_definition, PREORDER);
      } else {
	oldtype = type;
	type = lksucc (type, ttype_definition, PREORDER);
	ntype->brothers = oldtype->brothers;
	ntype->father   = oldtype->father;

	if (gt_lb(oldtype) != NULL)
	  gt_lb(oldtype)->brothers = ntype;
	else
	  ntype->father->sons = ntype;

	oldtype->father   = NULL;
	oldtype->brothers = NULL;
      }
    }
    for (auxt = lksucc (r, tlibrary_declaration, PREORDER);
	 auxt != NULL;
	 auxt = lksucc (auxt, tlibrary_declaration, PREORDER)){
      for (type = gt_fs (auxt); type != NULL;){
	exp = (TNexp*) find_attr (c_exp, type)->value;

	tid = (int)find_attr (c_idref, type)->value;
	ntype=mktype (exp,TRUE,(TNODE*)ATfind (ATable,tid,c_addr)->value);

	if (flagc){
	  if (isformal (type)){
	    set_attr (c_isformal, ntype, (CLR_TYPE)0);
	  }
	  cut_tree(ntype);
	  (void)lnsons (stypes, ntype);
	  type = gt_rb( type);
	} else{
	  oldtype = type;
	  type = gt_rb( type);
	  ntype->brothers = oldtype->brothers;
	  ntype->father   = oldtype->father;
	  if (oldtype != oldtype->father->sons)
	    gt_lb(oldtype)->brothers = ntype;
	  else
	    oldtype->father->sons = ntype;
	}
      }
      if (! flagc){
	(void) lnsons (auxt->father, auxt->sons);
	tmp = gt_ft(auxt);
	cut_tree (auxt);
	auxt = tmp;
      }
    }

  }
  if ((flagf) && (ragerrors == 0)){
    nexp = NULL;
    for (type = lksucc (r, ttype_definition, PREORDER); type != NULL;){
      if (!isformal(type)){
	exp = (TNexp*) find_attr (c_exp, type)->value;
	for (aux = exp; aux->next != NULL; aux = aux->next);
	aux->next=nexp;
	nexp=exp;
      }
      oldtype = type;
      type = lksucc (type, ttype_definition, PREORDER);
      cut_tree (oldtype);
    }
    for (auxt = lksucc (r, tlibrary_declaration, PREORDER);
	 auxt != NULL;
	 auxt = lksucc (auxt, tlibrary_declaration, PREORDER)){
      for (type = gt_fs (auxt); type != NULL; ){
	if (!isformal(type)){
	  exp = (TNexp*) find_attr (c_exp, type)->value;
	  for (aux = exp; aux->next != NULL; aux = aux->next);
	  aux->next=nexp;
	  nexp=exp;
	}
	oldtype = type;
	type = gt_rb (type);
	cut_tree (oldtype);
      }
    }
    if (r -> type != tdata_type_definitions){
      prd = gt_rb(gt_rb(gt_fs(r)));
      if (prd->type != tdata_type_definitions)
	prd = gt_rb(prd); /* data_type_definitions */
    }

    ntype = new_node (ttype_definition);
    ntype->value0 = (CLR_TYPE) IATadd (grntype_definition, grnl, TRUE);
    ntype->value1 = (CLR_TYPE) 3;

    ntype->sons = new_node (ttype_identifier);
    ntype->sons->value0= (CLR_TYPE) IATadd (grntype_identifier, grnl, TRUE);
    ntype->sons->value1= (CLR_TYPE) 0;
    if (r->type == tspecification){
      set_attr (c_lexv, ntype->sons, find_attr (c_lexv, r->sons)->value);
    } else {
      set_attr (c_lexv, ntype->sons, (CLR_TYPE ) 0);
    }
    set_attr (c_iddec, ntype->sons,
      (CLR_TYPE ) tdec (find_attr (c_lexv, ntype->sons)->value, ntype->sons));

    ntype->sons->brothers = new_node (tp_expression);
    ntype->sons->brothers->value0= (CLR_TYPE)IATadd(grnp_expression,grnl,TRUE);
    ntype->sons->brothers->value1= (CLR_TYPE) 2;

    ntype->sons->brothers->sons = new_node (tp_specification);
    ntype->sons->brothers->sons->value0=
			 (CLR_TYPE)IATadd(grnp_specification,grnl,TRUE);
    ntype->sons->brothers->sons->value1= (CLR_TYPE) 0;

    if (nexp != NULL){
      ntype = mktype (nexp, TRUE, (TNODE*)ntype);
      ntype->value0 = (CLR_TYPE) IATadd (grntype_definition, grnl, TRUE);

      if (r -> type == tdata_type_definitions){
	r->sons = ntype;
	ntype->father = r;
	ntype->brothers = NULL;
      } else {
	prd->sons = ntype;
	ntype->father = prd;
	ntype->brothers = NULL;
      }
      if (ntype->sons->brothers->sons->type == ttype_union)
	cut_tree (ntype->sons->brothers->sons);
    }
    else ntype = NULL;
  }

  if ((flagd < 1)&& ((flags != 0) || (flagf != 0))){
    if (flagL == 0)
      name2clr("L")	->put=NULL;
  }
  if (flagd < 2) {
    name2clr("types")	->put=NULL;
    name2clr("opns")	->put=NULL;
    name2clr("ropns")	->put=NULL;
    name2clr("sorts")	->put=NULL;
    name2clr("rsorts")	->put=NULL;
    name2clr("fsorts")	->put=NULL;
    name2clr("fopns")	->put=NULL;
    name2clr("inher")	->put=NULL;
    name2clr("poss")	->put=NULL;
    name2clr("rposs")	->put=NULL;
  }
  if (flagd < 3) {
    if (flagL == 0){
      name2clr("exp")	->put=NULL;
      name2clr("argl")	->put=NULL;
      name2clr("nar")	->put=NULL;
      name2clr("deps")	->put=NULL;
      name2clr("gate")	->put=NULL;
    }
    name2clr("addr")	->put=NULL;
    name2clr("scp")	->put=NULL;
    name2clr("replace")	->put=NULL;
    name2clr("vals")	->put=NULL;
    name2clr("ltypes")	->put=NULL;
    name2clr("procs")	->put=NULL;
    name2clr("locals")	->put=NULL;
    name2clr("lprocs")	->put=NULL;
    name2clr("nopns")	->put=NULL;
    name2clr("nfopns")	->put=NULL;
    name2clr("nsorts")	->put=NULL;
    name2clr("nfsorts")	->put=NULL;
    name2clr("gs")	->put=NULL;
    name2clr("go")	->put=NULL;
    name2clr("repsorts")->put=NULL;
    name2clr("repopns")	->put=NULL;
    name2clr("gates")	->put=NULL;
    name2clr("func")	->put=NULL;
    name2clr("question")->put=NULL;
    name2clr("varsort")	->put=NULL;
    name2clr("oldexp")	->put=NULL;
    name2clr("class")	->put=NULL;
    name2clr("F1")	->put=NULL;
    name2clr("S_F1")	->put=NULL;
    name2clr("FOP1")	->put=NULL;
    name2clr("OP_FOP1")	->put=NULL;
    name2clr("F2")	->put=NULL;
    name2clr("S_F2")	->put=NULL;
    name2clr("FOP2")	->put=NULL;
    name2clr("OP_FOP2")	->put=NULL;
    name2clr("tiddec")	->put=NULL;
    name2clr("tidref")	->put=NULL;
    name2clr("S1")	->put=NULL;
    name2clr("OP1")	->put=NULL;
    name2clr("actren")	->put=NULL;
    name2clr("esid")	->put=NULL;
    name2clr("eoid")	->put=NULL;
    name2clr("formal")	->put=NULL;
    name2clr("oformal")	->put=NULL;
    name2clr("tline")	->put=NULL;
  }

  set_attr (c_sp, r, (CLR_TYPE) spec_unique);
  set_attr (c_ty, r, (CLR_TYPE) type_unique);
  set_attr (c_pr, r, (CLR_TYPE) proc_unique);
  set_attr (c_so, r, (CLR_TYPE) sort_unique);
  set_attr (c_fs, r, (CLR_TYPE) fsort_unique);
  set_attr (c_op, r, (CLR_TYPE) opns_unique);
  set_attr (c_fo, r, (CLR_TYPE) fopns_unique);
  set_attr (c_ga, r, (CLR_TYPE) gate_unique);
  set_attr (c_va, r, (CLR_TYPE) vals_unique);
  set_attr (c_ac, r, (CLR_TYPE) act_unique);
  set_attr (c_luid, r, (CLR_TYPE) ATable->size);

  if (ragerrors != 0){
    (void) fprintf (stderr, "***  lsa: errors detected \n\n");
    if (flagd != 0){
      at = new_node (0);
      assert (at != NULL);
      set_attr(c_at, at, (CLR_TYPE) ATable);
      set_attr(c_ct, at, (CLR_TYPE) CSTable);
      set_attr(c_ll, at, (CLR_TYPE) take_attr (c_ll, r)->value);
      save_tree(ofs, r);
      save_tree(aofs, at);
    }
    if (strlen (lfile) != 0){
      (void) fclose (lfp);
      (void) fclose (lafp);
    }
    if (strlen (sfile) != 0)
      (void) fclose (sfp);

    (void) fclose (aofs);

    exit(1);
  }

  if (flagC)
    if (TRUE != compact (r)){
      fataler ("lsa: bad compression of lists of sorts and operations");
      exit(1);
    }

  at = new_node (0);
  assert (at != NULL);
  set_attr(c_at, at, (CLR_TYPE) ATable);
  set_attr(c_ct, at, (CLR_TYPE) CSTable);
  set_attr(c_ll, at, (CLR_TYPE) take_attr (c_ll, r)->value);
  save_tree(ofs, r);
  save_tree(aofs, at);
  (void) fclose (aofs);

  if (strlen (sfile) != 0)
    (void) fclose (sfp);
  if (strlen (lfile) != 0){
    (void) fclose (lfp);
    (void) fclose (lafp);
  }

  if (flagc){
    rfp = efopen (crfile, "w", "lsa");
    if (flagd != 0){
    set_attr(c_name, stypes, find_attr (c_name, r)->value);
    set_attr(c_grnl, stypes, (CLR_TYPE) grnl);
    }
    save_tree (rfp, stypes);
    (void) fclose (rfp);
  }

  exit(0);
  return 0;
}


/*
  Includes the lexv table of library into the
  specification lexv table
*/

PRIVATE void
llinc   (atlib, llib, spec, lat)
	TNODE*  atlib; /* library at */
	TNODE*	llib;  /* library ast */
	TNODE*	spec;  /* library ast */
	AT*   lat;
{

  int*	Lconv; /* tbl for lexv conversion */
  int*	Gconv; /* tbl for grnl conversion */
  ST*	tlib;
  IAT*  grnllib;

  HT     htspec;
  TATTR* attr;
  TNODE* aux;
  int*	 where;
  int	 libindex;
  int	 i;

  tlib  = (ST*) find_attr (c_ll, atlib)->value;
  grnllib = (IAT*) find_attr (c_grnl, llib)->value;

  htspec = STHinit (tspec, 1613);
  Lconv = (int*) malloc ((unsigned)(tlib->size * sizeof (int)));
  Gconv = (int*) malloc ((unsigned)(grnllib->size * sizeof (int)));

  if ((Lconv == NULL) || (Gconv == NULL)){
    fataler ("lsa: not enough memory");
    exit (1);
  }

  for ( i=0; i< tlib->size; i++)
    Lconv[i] = STHadd (tlib->data[i], tspec, htspec, TRUE);

  for ( i=0; i < grnllib->size; i++)
    Gconv[i] = IATadd (grnllib->data[i], grnl, TRUE);

  for (aux = lib; aux != NULL; aux = succ (aux, PREORDER)){
    if ((attr=find_attr( c_line, aux)) != NULL){
      libindex = Lconv[((int*)attr->value)[1]];
      break;
    }
  }
  for (aux = lib; aux != NULL; aux = succ (aux, PREORDER)){
    aux -> value0 = (CLR_TYPE) Gconv[(int)aux->value0];
    if ((attr=find_attr( c_lexv, aux)) != NULL)
      attr -> value = (CLR_TYPE) Lconv[(int)attr->value];
    if ((attr=find_attr( c_ofsort, aux)) != NULL)
      attr -> value = (CLR_TYPE) Lconv[(int)attr->value];
    if ((attr=find_attr( c_line, aux)) != NULL){
      where = (int*) attr->value;
      where[1] = libindex;
    }
    /*
    if ((attr=find_attr( c_exp, aux)) != NULL){
      exp= attr->value;
      for (;exp!= NULL; exp = exp->next)
	exp->type = (TNODE*) Lconv [(int) exp->type];
    }
    */
  }

  for (i=1; i< lat->size; i++){
    lat->data[i].value1 = (CLR_TYPE)Lconv [(int) lat->data[i].value1];
    if ((int)lat->data[i].value0 == TTYPE){
      for (aux = gt_fs (lib);
	   (aux != NULL) && ((int)find_attr(c_iddec,gt_fs(aux))->value!=i);
	   aux = gt_rb(aux));
      assert (aux != NULL);
      ATset (lat, i, c_addr, (CLR_TYPE)aux);
    }

  }

  spec_unique  = (int) find_attr (c_sp, llib)->value;
  type_unique  = (int) find_attr (c_ty, llib)->value;
  proc_unique  = (int) find_attr (c_pr, llib)->value;
  sort_unique  = (int) find_attr (c_so, llib)->value;
  fsort_unique = (int) find_attr (c_fs, llib)->value;
  opns_unique  = (int) find_attr (c_op, llib)->value;
  fopns_unique = (int) find_attr (c_fo, llib)->value;
  gate_unique  = (int) find_attr (c_ga, llib)->value;
  vals_unique  = (int) find_attr (c_va, llib)->value;

}

/*
  It generates the table of annotations
*/

PRIVATE AT*
cmd   (spec)
	TNODE*  spec;   /* specification ast node */
{

  TNODE*  ldcinit;
  TNODE*  ldcb;
  TNODE*  ldce;
  TNODE*  aux;
  AT*     atsp;
  int     i;
  int	  found;

  atsp = ATcreate (16, 16);

  aux = gt_fs(gt_rb(gt_rb(gt_fs(spec))));
  for (found=FALSE, ldcb=NULL;
       aux != NULL;
       aux = gt_rb(aux)){
    if (find_attr (c_ldc,aux) != NULL){
      if (found == TRUE){
	fataler ("lsa: only one ldc annotation at the specification begin");
	exit (1);
      } else {
	found = TRUE;
	ldcb = aux;
      }
    }
  }
  aux = gt_fs(gt_rb(gt_rb(gt_fs(spec))));
  for (found=FALSE, ldcinit=NULL;
       aux != NULL;
       aux = gt_rb(aux)){
    if (find_attr (c_ldcinit,aux) != NULL){
      if (found == TRUE){
	fataler ("lsa: only one ldcinit annotation at the specification begin\n");
	exit (1);
      } else {
	found = TRUE;
	ldcinit = aux;
      }
    }
  }
  aux = gt_fs (gt_ls(spec));
  for (found=FALSE, ldce=NULL;
       aux != NULL;
       aux = gt_rb(aux)){
    if (find_attr (c_ldc,aux) != NULL){
      if (found == TRUE){
	fataler ("lsa: only one ldc annotation at the specification begin\n");
	exit (1);
      } else {
	found = TRUE;
	ldce = aux;
      }
    }
  }

  if (ldcb != NULL){
    i = ATinc(atsp);
    atsp->data[i].value0= (CLR_TYPE)LDCBEGIN;
    atsp->data[i].value1= (CLR_TYPE)0;
    ATset (atsp, i, c_line, find_attr(c_line, ldcb)->value);
    ATset (atsp, i, c_ldc,  find_attr(c_ldc , ldcb)->value);
  }
  if (ldce != NULL){
    i = ATinc(atsp);
    atsp->data[i].value0= (CLR_TYPE)LDCEND;
    atsp->data[i].value1= (CLR_TYPE)0;
    ATset (atsp, i, c_line, find_attr(c_line, ldce)->value);
    ATset (atsp, i, c_ldc,  find_attr(c_ldc , ldce)->value);
  }
  if (ldcinit != NULL){
    i = ATinc(atsp);
    atsp->data[i].value0= (CLR_TYPE)LDCINIT;
    atsp->data[i].value1= (CLR_TYPE)0;
    ATset (atsp, i, c_line, find_attr(c_line, ldcinit)->value);
    ATset (atsp, i, c_ldcinit,  find_attr(c_ldcinit , ldcinit)->value);
  }

  return atsp;
}
