/******************************************************
 *      genC.c: Lambda Beta to C compiler
 ******************************************************/
/***********************************
   (C) Copyright 1992-1993; dit/upm
   Distributed under the conditions stated in the
   TOPO General Public License (see file LICENSE)
 ***********************************
 $Log: genC.c,v $
 * Revision 2.19  1994/07/20  17:11:15  lotos
 * Commented still not used code for unused variables due to a bug
 *
 * Revision 2.18  1994/01/10  09:24:09  lotos
 * removed unused function who_is_it
 * fixed little bug while printing annotation wait
 * removed redundant initialization of variable crt
 *
 * Revision 2.17  1993/12/03  15:29:10  lotos
 * incluido tratamiento de anotaciones en TODOS los operadores LOTOS.
 *
 * Revision 2.16  1993/11/08  17:10:11  lotos
 * Anyadido casting en anotacion default para
 *   operador choice masivo sobre variables.
 * En los procesos ligeros, el contexto se trata
 *   como un proceso normal
 * Eliminada funcion begin_coroutine (por no hacer nada)
 *
 * Revision 2.15  1993/10/14  15:37:50  lotos
 * various bug fixing
 *
 * Revision 2.14  1993/08/02  17:02:09  lotos
 * modificado los castings y tipados de las listas de puertas.
 * Se incrementa el garbage collector cada vez que se comparte
 *   una lista de puertas.
 * Adaptado al nuevo EPS (desaparece funcion get_gte).
 *
 * Revision 2.13  1993/07/21  09:05:05  lotos
 * delete unused function ("INTelem")
 * unify GOTO_AGAIN & END_ENTRY. Not, GOTO_AGAIN does both things
 * corrected a spelling mistake
 *
 * Revision 2.12  1993/07/06  15:12:32  lotos
 * bug fixing
 *
 * Revision 2.11  1993/06/28  18:29:35  lotos
 * add father to _gate_domain_list
 * default in gate declaration collecting
 * light coroutines have vars and gates (new)
 *
 * Revision 2.10  1993/06/25  13:15:58  lotos
 * fix generation of TSsort%d y TSsorts
 * data structures TSsort%d, TSvar%s y TSgate%s, now static
 *
 * Revision 2.9  1993/06/23  18:50:41  lotos
 * corrected max_var calculation.
 * fix unique names generation
 *
 * Revision 2.8  1993/06/16  14:11:11  lotos
 * colours c_light y c_from become public
 * remove option -i
 * add #line (and option -l to inhibit it)
 * transformation phase becomes independent: no global variables
 * data names pay attention to annotation CALL
 *
 * Revision 2.7  1993/05/07  14:46:10  lotos
 * Para arreglar los errores de indices en las trazas de depuracion:
 *     - Se ha anyadido un array de listas de puertas para simplificar la
 *     impresion de las tablas
 * - el Array de procesos se ha cambiado a char**
 * - la impresion de las tablas se ha modificado. Se han eliminado los
 *   arrays intermedios (gates1, gates2, etc)
 * -pequenya mejora del 'look' del codigo producido.
 *
 * Revision 2.6  1993/02/22  16:13:48  lotos
 * fix name generation for C variables --bug fix
 *
 * Revision 2.5  1993/01/18  18:14:46  lotos
 * distribution issues
 *
 * Revision 2.4  1993/01/12  20:20:49  lotos
 * portability issues
 *
 * Revision 2.3  1993/01/11  18:33:09  lotos
 * overall bug fixing
 * new variable specpar: # of parameters in the lotos spec
 * formal parameters in processes are not compacted any longer
 * reverse -i meaning
 * add -C to remove would-be-generated files
 * generates code for if and use annotations
 * it is valid to split into 1 piece (no effect, really)
 * remove tbil.hh, replaced by conf.h
 *
 * Revision 2.2  1992/11/19  11:43:06  lotos
 * fix file naming
 * close brackets in code generated for guards and predicates
 *
 * Revision 2.1  1992/11/17  17:37:29  lotos
 * variables are compacted per sort
 * split generated code into several files
 * generates *.hh
 * admit option to change basename
 * adapted to use c_cui's
 * modify sort tables
 * code generation is more rational (needs further polishing ...)
 * adapted to new data type conventions
 * adopt new naming convention
 * include var declaration list in light BUTs
 *
 * Revision 1.3  1992/11/17  17:10:20  lotos
 * generate macros for repetitive parts
 * start moving towards shared variables
 * clean generated code
 *
 * Revision 1.2  1992/09/11  16:48:49  lotos
 * bug fixing
 *
 * Revision 1.1  1992/09/02  16:58:07  lotos
 * Initial revision
 *
 ***********************************/

#ifndef lint
static char rcsid[]= "$Id: genC.c,v 2.19 1994/07/20 17:11:15 lotos Exp $";
#endif

#define ITEMS 5
#define DOUBLE_ITEMS 10

#define PRINT_RC        (void)fprintf (codf, "\n")
#define GOTO_AGAIN      (void)fprintf (codf, "    goto again;\n  }\n")
#define BREAK_END_ENTRY (void)fprintf (codf, "    break;\n  }\n")

#define INTdup(l) ((INTlist)cIL((CLR_TYPE)l))

# include "swbus.h"

/* At first view, it is needed only 33. But the next_pos function */
/* is blind, so it need ONE MORE THAN ALLOWED IN THE rag STUFF!!! */
#define MAX_TNODES 34

PUBLIC int max_val;
PUBLIC int *used_var_tbl = NULL;
PUBLIC tvarsort **tvs; /* One for each BUT */

PRIVATE FILE *codf = NULL;                /* File in which code is printed */
PRIVATE FILE *incf = NULL;       /* File in which declarations are printed */

PRIVATE ST      *eval_tbl;
PRIVATE char    **TSprocess;
PRIVATE INTlist *TSgates;
PRIVATE INTlist *TSvars;
PRIVATE int     max_gte = 0, max_accepted = 0, max_exp = 0;

#define NO_ANNOT -1

PRIVATE int  annot_type = 0;                 /* To select, by side effect, */
					     /* the annotation to print    */

PRIVATE int     flag_grd = 0, crt;
PRIVATE INTlist ilist;
PRIVATE INTlist gate_decl_list; /* Global. Each entry know all gates       */
PRIVATE INTlist var_decl_list;  /* Global. Each entry know all vars        */
PRIVATE INTlist parameter_list; /* Global. Each entry know all parameters  */
PRIVATE INTlist local_var_decl; /* Global. Value_exp know local vars       */
PRIVATE INTlist value_exp_used; /* Global. Position within experiment_list */
PRIVATE INTlist sort_list_exp; /* Global. For each exp, sort list is known */
PRIVATE int     pred_flag;    /* To know if we are printing the predicates */
PRIVATE int     lbc_before = FALSE; /* To know if it is the fist lbc annot */

PRIVATE void genlbm ();

PRIVATE int
identifier (r)
  TNODE *r;
{
  TATTR *auxclr = NULL;

  if ((auxclr = find_attr (c_iddec, r)) != NULL)
    return (int)auxclr->value;
  if ((auxclr = find_attr (c_idref, r)) != NULL)
    return (int)auxclr->value;
  fatal_error ("cannot find identifier", __FILE__, __LINE__);
  return -1; /* To shut lint off */
}

PRIVATE int
varpos (var, vl)
  int     var;
  INTlist vl;
{
  register int i = 0;

/* if (!debug_code)    / If not debuging, 0 is assigned to no-used vars /
    if (!used_var_tbl[id2ui (val)])
      return 0;
*/
  for ( ; vl != NULL; vl = INTtail (vl), i++)
    if (var == INThead (vl))
      return i;
  return -1;
}

/* It returns the position of the variable 'var' in the list     */
/* 'vl', but taking into account the compactation of vars,       */
/* registered in the tables 'tvs', which is indexed by BUT.      */
/* First, we need the position of 'var' by 'sort'. For instance, */
/* suppose b1, b2 and b3 of bool and n1, n2 of nat, and suppose  */
/* we have the following declaration : 'b1, n1, n2, b2, b3. Then */
/* b1 is '1', b2 is '2', b3 is '3', n1 is '1' and n2 is '2'.     */
/* Then, we have to calculate the 'offset' and add it. In the    */
/* example, b1 is '1', b2 is '2', b3 is '3', n1 is '4' and n2 is */
/* '5'. This is the value to be returned.                        */
/* However, if producing code for debuging, it is return the     */
/* position within 'vl, calculates by 'varpos'.                  */
/* The exception to all this rules is when the variable is a     */
/* formal parameter of the process. Then its index is returned.  */
PRIVATE int
cvarpos (var, vl)
  int     var;
  INTlist vl;
{
  register int i = 0;
  /* KJT 20/01/23: added "int" type */
  register int sort;

  if (debug_code)
    return varpos (var, vl);
  if (INTIsIn (var, paramtbl[crt]))
    return varpos (var, paramtbl[crt]);
  sort = id2sort ((CLR_TYPE)var);
  for ( ; vl != NULL; vl = INTtail (vl)) {
    if (sort == id2sort ((CLR_TYPE)INThead (vl)))
      i++;                            /* We only count by 'sort' */
    if (var == INThead (vl))           /* Found!. Let's continue */
      break;
  }
  if (vl == NULL)                           /* It was not found! */
    return -1;
  return INTlength (paramtbl[crt]) + PosVS (tvs[crt], sort)->pos + i - 1;
}

/* Checks if a list of gates needs relabel. */
PRIVATE int
need_relabel (gtel)
  INTlist gtel;
{
  register int i = 1;

  for ( ; gtel != NULL; gtel = INTtail (gtel), i++)
    if (i != INTpos (INThead (gtel), gate_decl_list))
      return TRUE;
  return FALSE;
}

/* Given a relabel node, it returns the gate in which
 * v is relabeled
 */
PRIVATE int
gte_relabeled (v, r)
  int v;
  TNODE *r;
{
  INTlist decl = NULL;  /* list of gates which relabel */
  INTlist actl = NULL;  /* list of gates for relabeling */

  assert (r != NULL);
  assert (r->type == trelabel);
  decl = (INTlist) takeclr (c_gate_decl, r);
  actl = (INTlist) takeclr (c_gate_list, r);
  for ( ; (decl != NULL) && (actl != NULL);
       decl = INTtail (decl), actl = INTtail (actl))
    if (INThead (decl) == v)
      return INThead (actl);
  fatal_error ("cannot find gate for relabeling", __FILE__, __LINE__);
  return 0; /* To shut lint off */
}

/* Search if the identifier 'id' is used in 'r' or in any of its sons */
PRIVATE int
IsInNode (id, r)
  int id;
  TNODE *r;
{
  TATTR *aux;

  if ((aux = find_attr (c_idref, r)) != NULL)
    if ((int)aux->value == id)
      return TRUE;
  for (r = gt_fs (r); r != NULL; r = gt_rb (r))
    if (IsInNode (id, r))
      return TRUE;
  return FALSE;
}

PRIVATE void
begin_entry (r)
  TNODE *r;
{
  (void)fprintf (codf, "  case %d: {\n", (int)takeclr (c_entry, r));
}

PRIVATE char*
search_priority (r)
  TNODE *r;
{
  TATTR *a;

  if (r != NULL)
    for (r = gt_fs (r); r != NULL; r = gt_rb (r))
      if ((a = find_attr (c_priority, r)) != NULL)
	return (char*)a->value;
  return "0";
}

/* Prints the table of sorts of a given corroutine. */
/* 'vl' is the var declaration list of such BUT.    */
PRIVATE void
print_sort_table (vl, corr)
  INTlist vl;
  int corr;
{
  int j, num;
  tvarsort *aux = NULL;
  INTlist al = NULL;

  if ((tvs[corr] == NULL) && (vl == NULL) && (paramtbl[corr] == NULL))
				    /* KJT 14/08/00: 0 not NULL value */
    (void)fprintf (codf, "static int TSsort%d[]= { 0 }; /* %s */\n\n",
		   corr, TSprocess[corr]);
  else {
    (void)fprintf (codf, "static int TSsort%d[]= { /* %s */\n  ",
		   corr, TSprocess[corr]);
    if (debug_code) {
      for (num = 1; vl != NULL; vl = INTtail (vl), num++) {
	if (INThead (vl) != 0)
	  (void)fprintf (codf, "%d", id2sort ((CLR_TYPE)INThead (vl)));
	else
	  (void)fprintf (codf, "-1"); /* to check */
	if (INTtail (vl) != NULL) {
	  (void)fprintf (codf, ", ");
	  if (!(num % DOUBLE_ITEMS))
	    (void)fprintf (codf, "\n  ");
	}
      }
    }
    else {                  /* Well, we'd compacted variables. */
      /* First, we will print the formal parameters of the process */
      for (num = 1, al = paramtbl[corr];
	   al != NULL;
	   al = INTtail (al), num++) {
	(void)fprintf (codf, "%d, ", id2sort ((CLR_TYPE)INThead (al)));
	if (!(num % DOUBLE_ITEMS))
	  (void)fprintf (codf, "\n  ");
      }

      /* Now, let's print the rest of variables in the process */
      for (aux = tvs[corr]; aux != NULL; aux = aux->next) {
	for (j = 0; j < aux->num; j++, num++) {
	  (void)fprintf (codf, "%d, ", aux->sort);
	  if (!(num % DOUBLE_ITEMS))
	    (void)fprintf (codf, "\n  ");
	}
      }
      (void)fprintf (codf, "0");    /* To end the array. Not usefull */
    }
    (void)fprintf (codf, "\n  };\n\n");
  }
}

PRIVATE void
print_predicates ()
{
  int i;
  TATTR *taux;

  pred_flag = TRUE;
  for (i = 0; i < pred_tbl->size; i++) {
    (void)fprintf (codf, "PUBLIC int\n");
    (void)fprintf (codf, "t00%d (M)\n", i);
    (void)fprintf (codf, "  frame M;\n");
    (void)fprintf (codf, "{\n");
    var_decl_list = NULL;
    if ((taux = find_attr (c_var_decl_list, (TNODE*)(pred_tbl->data[i])))
	!= NULL)
      var_decl_list = (INTlist)taux->value;
    crt = (int)takeclr (c_this_BUT_ui, (TNODE*)(pred_tbl->data[i]));
    parameter_list = paramtbl[crt];
    genlbm ((TNODE*)(pred_tbl->data[i]));
    (void)fprintf (codf, "}\n\n");
  }
  PRINT_RC;
}

PRIVATE void
print_tables ()
{
  int max, i, k, *dat;
  INTlist il = NULL;

	 /***** PROCESSES NAMES *****/
  if (debug_code) {
    (void)fprintf (codf, "char*  TSprocesses[]= {\n  ");
    for (i = 1; i <= lastBUTnumber; i++) {
      (void)fprintf (codf, "\"%s\"", TSprocess[i-1]);
      if (i < lastBUTnumber) {
	(void)fprintf (codf, ", ");
	if (!(i % ITEMS))
	  (void)fprintf (codf, "\n  ");
      }
    }
    (void)fprintf (codf, "\n  };\n\n");
  }
  else
    (void)fprintf (codf, "char*  TSprocesses[]= {\"\"};\n\n");

	 /***** GATES OF PROCESSES *****/
	 /* There are always gates to print - the "exit" gate */
  if (debug_code) {
    for (i = 0; i < lastBUTnumber; i++) {
      (void)fprintf (codf, "static char*  TSgate%d[]= { /* %s */\n",
		     i, TSprocess[i]);
      (void)fprintf (codf, "\t\"exit\"");
      for (k = 1, il = TSgates[i]; il != NULL ; k++, il = INTtail (il)) {
	if (k <= max_gte) {
	  (void)fprintf (codf, ",");
	  if (!(k % ITEMS))
	    (void)fprintf (codf, "\n");
	}
	(void)fprintf (codf, "\t\"%s\"", l2s (INThead (il)));
      }
      (void)fprintf (codf, "\n  };");
      if ((i+1) < lastBUTnumber)
	(void)fprintf (codf, "\n\n");
    }
    (void)fprintf (codf, "\n\n");

    (void)fprintf (codf, "char** TSgates[]= {\n  ");
    for (i = 1; i <= lastBUTnumber; i++) {
      (void)fprintf (codf, "TSgate%d", i-1);
      if (i < lastBUTnumber) {
	(void)fprintf (codf, ", ");
	if (!(i % ITEMS))
	  (void)fprintf (codf, "\n  ");
      }
    }
    (void)fprintf (codf, "\n  };\n\n");
  }
  else
    (void)fprintf (codf, "char** TSgates[]= {TSprocesses};\n\n");

	       /***** VARIABLES OF PROCESSES *****/
  if (debug_code) {
    for (k = 0; k < lastBUTnumber; k++) {
      ilist = TSvars[k];
      if (ilist == NULL)
	(void)fprintf (codf, "static char *TSvar%d[]= { NULL }; /* %s */\n\n",
		       k, TSprocess[k]);
      else {
	(void)fprintf (codf, "static char *TSvar%d[]= { /* %s */\n  ",
		       k, TSprocess[k]);
	for (i = 1; ilist != NULL; ilist = INTtail (ilist), i++) {
	  if (INThead (ilist) != 0)
	    (void)fprintf (codf, "\"%s\"", l2s (INThead (ilist)));
	  else
	    (void)fprintf (codf, "\"\"");
	  if (INTtail (ilist) != NULL) {
	    (void)fprintf (codf, ", ");
	    if (!(i % ITEMS))
	      (void)fprintf (codf, "\n  ");
	  }
	}
	(void)fprintf (codf, "\n  };\n\n");
      }
    }

    (void)fprintf (codf, "char** TSvariables[]= {\n  ");
    for (i = 1; i <= lastBUTnumber; i++) {
      (void)fprintf (codf, "TSvar%d", i - 1);
      if (i < lastBUTnumber) {
	(void)fprintf (codf, ", ");
	if (!(i % ITEMS))
	  (void)fprintf (codf, "\n  ");
      }
    }
    (void)fprintf (codf, "\n  };\n\n");
  }
  else
    (void)fprintf (codf, "char** TSvariables[]= {TSprocesses};\n\n");


	     /***** SORTS OF VARIABLES *****/
  for (i = 0; i < lastBUTnumber; i++)
    print_sort_table (TSvars[i], i);

  (void)fprintf (codf, "int*  TSsorts[]= {\n  ");
  for (i = 0; i < lastBUTnumber; i++) {
    (void)fprintf (codf, "TSsort%d", i);
    if ((i+1) < lastBUTnumber) {
      (void)fprintf (codf, ", ");
      if (!((i+1) % ITEMS))
	(void)fprintf (codf, "\n  ");
    }
  }
  (void)fprintf (codf, "\n  };\n\n");

	      /***** SIZES OF EXPERIMENTS *****/
  if (sort_tbl->size == 0)
    (void)fprintf (codf, "int TSsizes[]= { NULL };\n\n");
  else {
    (void)fprintf (codf, "int TSsizes[]= {\n  ");
    for (i = 1; i <= sort_tbl->size; i++) {
      (void)fprintf (codf, "%d", sizeIT (sort_tbl->data[i-1]));
      if (i < sort_tbl->size) {
	(void)fprintf (codf, ", ");
	if (!(i % DOUBLE_ITEMS))
	  (void)fprintf (codf, "\n  ");
      }
    }
    (void)fprintf (codf, "\n  };\n\n");
  }

	    /***** SORTS BY EXPERIMENT *****/
  for (i = 1; i <= sort_tbl->size; i++) {
    dat = sort_tbl->data[i-1];
    if (dat[0] == 0)		/* KJT 14/08/00: 0 not NULL value */
      (void)fprintf (codf, "static int TSsbe%d[] = { 0 };\n", i-1);
    else {
      (void)fprintf (codf, "static int TSsbe%d[] = { ", i-1);
      for (k = 0; dat[k] != 0; k++) {
	(void)fprintf (codf, "%d", id2ui((CLR_TYPE)dat[k]));
	if (dat[k+1] != 0) {
	  (void)fprintf (codf, ", ");
	  if (!((k+1) % ITEMS))
	    (void)fprintf (codf, "\n  ");
	}
      }
      (void)fprintf (codf, " };\n");
    }
  }
  if (sort_tbl->size == 0)
    (void)fprintf (codf, "int *TSsbes[]= { NULL };\n\n");
  else {
    (void)fprintf (codf, "\nint *TSsbes[]= {\n  ");
    for (i = 1; i <= sort_tbl->size; i++) {
      (void)fprintf (codf, "TSsbe%d", i-1);
      if (i < sort_tbl->size) {
	(void)fprintf (codf, ", ");
	if (!(i % ITEMS))
	  (void)fprintf (codf, "\n  ");
      }
    }
    (void)fprintf (codf, "\n  };\n\n");
  }

	  /***** TABLE OF EVAL ANOTATIONS *****/
  if (eval_tbl->size == 0)
    (void)fprintf (codf, "eval_f TSevals[]= { NULL };\n\n");
  else {
    (void)fprintf (codf, "eval_f TSevals[]= {\n  ");
    for (i = 1; i <= eval_tbl->size; i++) {
      (void)fprintf (codf, "%s", eval_tbl->data[i-1]);
      if (i < eval_tbl->size) {
	(void)fprintf (codf, ", ");
	if (!(i % DOUBLE_ITEMS))
	  (void)fprintf (codf, "\n  ");
      }
    }
    (void)fprintf (codf, "\n  };\n\n");
  }

	  /***** GLOBAL VARIABLES *****/
  (void)fprintf (codf, "int specpar = %d;\n", INTlength (paramtbl[0]));
  (void)fprintf (codf, "int max_accepted = %d;\n", max_accepted+1);
  (void)fprintf (codf, "int max_gte = %d;\n", max_gte+1);
  (void)fprintf (codf, "int max_val = %d;\n",
		 debug_code ? max_val+1 : totallength ()+1);
  (void)fprintf (codf, "int max_exp = %d;\n", max_exp+1);

  (void)fprintf (codf, "boolean g_flag = %s;\n\n",
		 debug_code ? "TRUE" : "FALSE");

	     /***** PREDICATE TABLE *****/
  if (pred_tbl->size == 0)
    (void)fprintf (codf, "predicate ftbl[]= { NULL };\n");
  else {
    (void)fprintf (codf, "predicate ftbl[]= {\n  ");
    for (i = 0; i < pred_tbl->size; i++) {
      (void)fprintf (codf, "t00%d", i);
      if ((i+1) < pred_tbl->size) {
	(void)fprintf (codf, ", ");
	if (!((i+1) % DOUBLE_ITEMS))
	  (void)fprintf (codf, "\n  ");
      }
    }
    (void)fprintf (codf, "\n  };\n\n");
  }

	    /***** COROUTINE TABLE *****/
  max = (lastBUTnumber > DOUBLE_ITEMS);
  (void)fprintf (codf, "coroutine ctbl[]= { ");
  if (max)
    (void)fprintf (codf, "\n  ");
  for (i = 0; i < lastBUTnumber; i++) {
    (void)fprintf (codf, "c%d", i);
    if ((i+1) < lastBUTnumber) {
      (void)fprintf (codf, ", ");
      if (max && !((i+1) % DOUBLE_ITEMS))
	(void)fprintf (codf, "\n  ");
    }
  }
  if (max)
    (void)fprintf (codf, "\n ");
  (void)fprintf (codf, " };\n\n");
}

PRIVATE void
print_delay_wait (r, annot_list)
  TNODE *r, *annot_list;
{
  /* Annotations DELAY and WAIT produce new states. */
  int nentry;
  TNODE *annot = NULL;

  nentry = (int)takeclr (c_entry, r) + 1;
  for (annot = gt_fs (annot_list);
       annot != NULL;
       annot = gt_rb (annot)) {
    if (find_attr (c_delay, annot) != NULL) {
      (void)fprintf (codf, "    mkdl (b, %d, ", nentry);
      annot_type = c_delay;
      genlbm (annot);
      (void)fprintf (codf, ");\n");
      BREAK_END_ENTRY;
      (void)fprintf (codf, "  case %d: {\n", nentry);
      nentry++;
    }
    if (find_attr (c_wait, annot) != NULL) {
      (void)fprintf (codf, "    mkwt (b, %d, ", nentry);
      annot_type = c_wait;
      genlbm (annot);
      (void)fprintf (codf, ");\n");
      BREAK_END_ENTRY;
      (void)fprintf (codf, "  case %d: {\n", nentry);
      nentry++;
    }
    if (find_attr (c_if, annot) != NULL) {
      (void)fprintf (codf, "    if (!(");
      annot_type = c_if;
      genlbm (annot);
      (void)fprintf (codf, ")) {\n");
      (void)fprintf (codf, "      mkst (b);\n");
      (void)fprintf (codf, "      break;\n");
      (void)fprintf (codf, "    }\n");
    }
  }
  annot_type = NO_ANNOT;
}

PRIVATE void
print_mkch (n, product)
  int n, product;
{
  int i;

  for (i = n; i < n+product-2; i++) {
    (void)fprintf (codf, "    mkch (b, %d, %d);\n", i+1, i+product-1);
    BREAK_END_ENTRY;
    (void)fprintf (codf, "  case %d: {\n", i+1);
  }
  if (product > 1) {
    (void)fprintf (codf, "    mkch (b, %d, %d);\n",
		   n+product+product-3, n+product+product-2);
    BREAK_END_ENTRY;
    (void)fprintf (codf, "  case %d: {\n", n+product-1);
  }
}

/* h[0] is supposed to be an external_offer. This function takes */
/* all the var_ids of the experiment_list -h[1]- with defaults   */
/* and puts them in the an array. For var_ids without default or */
/* value_exps, the correspondant h[i] is set to NULL.            */
PRIVATE void
find_defaults (h, an)
  TNODE *h[], *an[];
{
  int i = 0;
  TNODE *exp = NULL;

  assert (h[0]->type == texternal_offer);
  assert (h[1] != NULL);                     /* There is experiment_list */
  assert ((int)takeclr (c_product, h[1]) > 1); /* And there are defaults */

  for (i = 0; i < MAX_TNODES; i++)
    an[i] = NULL;

  for (exp = gt_fs (h[1]), i = 0;
       exp != NULL;
       exp = gt_rb (exp), i++) {
    an[i] = exp;
    if (exp->type == tvar_id)
      if ((int)takeclr (c_product, exp) > 1)
	an[i] = gt_fs (gt_fs (exp)); /* The first annotation of var_id */
  }
  assert (i == (int)takeclr (c_number_exp, h[0]));
}

/* It really prints out the code for each mk_ad */
PRIVATE void
code_mkad (r)
  TNODE *r;
{
  int var_id, srt;

  annot_type = c_default;
  if (r->type == tannotation) {    /* it should belong to a _var_id */
    var_id = (int)takeclr (c_var_id, r->father->father);
    (void)fprintf (codf, "    mkdef (%d, ud_copy (%d, (udatum)(",
		   cvarpos (var_id, var_decl_list),
		   id2sort ((CLR_TYPE)var_id));
    genlbm (r);
    (void)fprintf (codf, ")));\n");
  }
  else {         /* It should be a _value_exp or a single _var_id */
    if (r->type == tvalue_exp) {
      if (idclass (takeclr (c_idref, r)) == TOPN) {
	(void)fprintf (codf, "    mkso ((udatum)");
	genlbm (r);
	(void)fprintf (codf, ");\n");
      }
      else if (idclass (takeclr (c_idref, r)) == TVAL) {
	srt = id2sort ((CLR_TYPE)identifier (r));
	(void)fprintf (codf, "    mkso (ud_copy (%d, M->rav[%d]));\n",
		       srt, cvarpos (identifier (r), var_decl_list));
      }
      else fatal_error ("wrong idclass", __FILE__, __LINE__);
    }
    else
      genlbm (r);
  }
}

PRIVATE void
next_pos (an)
  TNODE *an[];
{
  TNODE *this;

  this = an[0];
  if (an[0]->type == tannotation) {
    an[0] = gt_rb (an[0]);
    if ((an[0] == NULL) && (an[1] != NULL)) {
      an[0] = this->father->sons; /* an[0] is set to the first brother */
      next_pos (&(an[1]));
    }
  }
  else
    if (an[1] != NULL)
      next_pos (&(an[1]));
}

/* It prints multiple mk_ads in the case of several defaults in the */
/* same experiment_list. It has been designed as a function because */
/* it is rather tricky, and I do not want it to pollute the rest of */
/* the code.                                                        */
PRIVATE void
print_mkads (h, n, product)
  TNODE *h[];
  int n, product;
{
  int ent, nent, i, cnt;
  TNODE *exps[MAX_TNODES]; /* Why 33? Because it is the maximun amount */
			   /* of TNODEs allowed in a rule in the rag.  */

  assert (h[0]->type == texternal_offer);
  find_defaults (h, exps);
  nent = (int)takeclr (c_entry, h[3]) - 1;

  ent = nent - product;
  for (cnt = 0; cnt < product; cnt++) {
    for (i = 0; (i < MAX_TNODES) && (exps[i] != NULL); i++) {
      code_mkad (exps[i]);
    }
    (void)fprintf (codf, "    M->ent = %d;\n", nent);
    GOTO_AGAIN;

    (void)fprintf (codf, "  case %d: {\n", ++ent);
    next_pos (exps);
  }
}

/* Prints #line directives */
PRIVATE void
print_line (f, r)
  FILE *f;
  TNODE *r;
{
  if (genline)
    if (find_attr (c_line, r) != NULL)
      (void)fprintf (f, "#line %d \"%s.lot\"\n",
		     *((int*)takeclr (c_line, r)), specname);
}

/* prints error message and line */
PRIVATE void
error_line (msg, r)
  char  *msg;
  TNODE *r;
{
  (void)fprintf (codf, "%s", msg);
  (void)fprintf (stderr, "%s", msg);
  if (find_attr (c_line, r) != NULL) {
    (void)fprintf (codf, ", in line %d", *((int*)takeclr (c_line, r)));
    (void)fprintf (stderr, ", in line %d", *((int*)takeclr (c_line, r)));
  }
  (void)fprintf (codf, "\n");
  (void)fprintf (stderr, "\n");
}

/* It converts $# into the proper formal variable within the */
/* process, and $!# into the variable from the experiment.   */
/* $$ escapes the dollar sign, though it is not allow in C.  */
/* EXCUSE indicates if $!# construction is allowed.          */
PRIVATE void
translate_annot (r, EXC_USE)
  TNODE *r;
  int   EXC_USE;
{
  char *s, *p;
  int inv, exclam;

  s = (char*)takeclr (annot_type, r);
  for (p = s; *p != '\0'; p++)
    if (*p == '$') {
      if (p[1] == '$') {
	(void)fprintf (codf, "$");
	p++;
      }
      else {
	exclam = (p[1] == '!');
	if (exclam && !EXC_USE) {
	  error_line ("Nosense annotation type and $!# operator", r);
	  exit (1);
	}
	if (exclam)
	  p++;
	if (!isdigit (p[1])) {
	  error_line ("Integer expected in annotation", r);
	  exit (1);
	}
	p++;
	inv = atoi (p);
	while (isdigit (p[0]))
	  p++;
	p--;
	if (exclam) {
	  if ((inv < 1) || (inv > INTlength (sort_list_exp))) {
	    error_line ("Index out of range in annotation", r);
	    exit (1);
	  }
	  if (!IsExtSrt (INTnth (inv, sort_list_exp)))
	    (void)fprintf (codf, "(kdatum)");
	  (void)fprintf (codf, "xto[%d]", inv-1);
	}
	else {
	  if ((inv < 1) || (inv > INTlength (parameter_list))) {
	    error_line ("Index out of range in annotation", r);
	    exit (1);
	  }
	  if (!IsExtVar (INTnth (inv, parameter_list)))
	    (void)fprintf (codf, "(kdatum)");
	  (void)fprintf (codf, "M->rav[%d]", inv-1);
	}
      }
    }
    else
      (void)fprintf (codf, "%c", *p);
}

PRIVATE void
genlbm (r)
  TNODE*	r;
{
  TNODE*	h[33];
  int	nar;
  int   i;        /* Auxiliar counter */

  if (r == NULL) return;
  nar= *(grnl->data[(int)(r->value0)]);
  switch (nar) {

  case _lbm_1 :
    h[0]= r;
    heval (h[0], h);

    flag_grd = 0;

    (void)fprintf (incf, "# include \"%s\"\n", ldcname);
    (void)fprintf (incf, "# include <stdio.h>\n");
    (void)fprintf (incf, "# include <assert.h>\n");
    (void)fprintf (incf, "# include \"lotos.hh\"\n\n");
    (void)fprintf (incf, "extern frame M;\n\n");
    if (max_val > 0)
      (void)fprintf (incf, "extern value     v[];\n");
    (void)fprintf (incf, "extern gate_list gts;\n");
    (void)fprintf (incf, "extern var_list  vrs;\n");
    (void)fprintf (incf, "extern int       i;\n\n");

    (void)fprintf (incf, "void ");
    for (i = 1; i <= lastBUTnumber; i++) {
      (void)fprintf (incf, "c%d()", i-1);
      if (i < lastBUTnumber) {
	if (!(i % ITEMS))
	  (void)fprintf (incf, ",\n     ");
	else
	  (void)fprintf (incf, ", ");
      }
    }
    (void)fprintf (incf, ";\n\n");

    (void)fprintf (codf, "# include \"%s\"\n\n", incname);
    i = 0; /* auxiliar to avoid calculations */
    if (debug_code)
      i = max_val;
    else
      i = totallength ();
    if (i > 0)
      (void)fprintf (codf, "value     v[%d];\n", i+1);
    (void)fprintf (codf, "gate_list gts;\n");
    (void)fprintf (codf, "var_list  vrs;\n");
    (void)fprintf (codf, "int       i;\n\n");

    (void)fprintf (codf, "frame M;\n\n");

    annot_type = c_lbc;
    lbc_before = TRUE;
    genlbm (h[1]);
    annot_type = NO_ANNOT;
    lbc_before = FALSE;
    genlbm (h[2]);
    annot_type = c_lbc;
    genlbm (h[3]);
    annot_type = NO_ANNOT;

    break;

  case _BUT_definition_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    {
      TNODE *taux = NULL;

      for (taux = gt_fs (r);
	   taux != NULL;
	   taux = gt_rb (taux)) {
	genlbm (taux);
	if (split_flag && (gt_rb(taux) != NULL)) {/* predicates in last file */
	  but_counter++; /* Counter of but printed in current part */
	  if ((but_counter % but_per_part) == 0) {
	    but_counter = 0;
	    if (but_redundant > 0)
	      but_redundant--;
	    if (but_redundant == 0) {
	      but_per_part--;
	      but_redundant--;       /* to avoid re-decrement but_per_part */
	    }
	    (void)fclose (codf);
	    (void)sprintf (codename, "%s%s.c",
			   basename, mkstr (split_counter++));
	    codf = efopen (codename, "w");
	    (void)fprintf (codf, "# include \"%s\"\n\n", incname);
	  }
	}
      }
    }
    break;

  case _BUT_definition_1 :
    h[0]= r;
    heval (h[0], h);

    crt = (int)takeclr (c_this_BUT_ui, r);
    if (debug_code)
      (void)fprintf (codf, "/* ----> %s */\n",
		     l2s (takeclr (c_BUT_number, r)));
    (void)fprintf (codf, "PUBLIC void\n");
    (void)fprintf (codf, "c%d (b)\n", crt);
    (void)fprintf (codf, "  board b;\n");
    (void)fprintf (codf, "{\n");
    (void)fprintf (codf, "  again: \n");
    (void)fprintf (codf, "  M = b->frm;\n\n");
    (void)fprintf (codf, "  switch (M->ent) {\n");
    TSprocess[crt] = l2s (takeclr (c_BUT_number, r));

    /* By side effect, all entries know which gates and */
    /* vars are declared. This is used to calculate the */
    /* position of each gate and var. The treatment is  */
    /* different if debuging option is set.             */

    /* Inicialization of variables */
    parameter_list = paramtbl[crt];
    var_decl_list = (INTlist)takeclr (c_var_decl_list, r);

    /* Inicialization of gates */
    gate_decl_list = (INTlist)takeclr (c_gate_decl_list, r);

    begin_entry (h[1]);
    genlbm (h[1]);

    (void)fprintf (codf, "  }\n");
    (void)fprintf (codf, "}\n\n");

    i = INTlength (gate_decl_list);
    if (i > max_gte)
      max_gte = i;
    i = INTlength (var_decl_list);

    if (debug_code) {
      TSgates[crt] = INTdup (gate_decl_list);
      TSvars[crt] = INTdup (var_decl_list);
    }
    else {
      gate_decl_list = NULL;
      var_decl_list = NULL;
    }

    break;

  case _let_exp_1 :
    h[0]= r;
    heval (h[0], h);

    if (!debug_code)
      var_decl_list = (INTlist)takeclr (c_var_decl_list, h[2]);
    if (h[3] != NULL)
      print_delay_wait (r, h[3]);

    genlbm (h[1]);
    genlbm (h[2]);

    break;

  case _var_choice_exp_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int n, product, var_id, next_entry;
      int ndels, nwaits;
      TNODE *annot = NULL;

      if ((product = (int)takeclr (c_product, h[1])) == 0) {
	error_line ("User may provide values for variables in choice\nwith the default annotation", (TNODE*)NULL);
	exit (1);
      }

      if (!debug_code)
	var_decl_list = (INTlist)takeclr (c_var_decl_list, h[2]);

      n = (int)takeclr (c_entry, r);
      if (h[3] != NULL) {
	ndels  = (int)takeclr (c_num_delays, h[3]);
	nwaits = (int)takeclr (c_num_waits,  h[3]);
	if (ndels && nwaits) {
	  print_delay_wait (r, h[3]);
	  n = (int)takeclr (c_entry, r) + ndels + nwaits;
	}
      }

      print_mkch (n, product);

      annot = h[1]->sons->sons->sons;      /* The annotations of var_id */
      annot_type = c_default;
      next_entry = (int)takeclr (c_entry, h[2]);
      var_id = (int)takeclr (c_var_id, h[1]->sons);

      for (i = 0; i < product; i++) {
	(void)fprintf (codf, "    M->rav[%d] = (udatum)",
		       cvarpos (var_id, var_decl_list));
	genlbm (annot);
	(void)fprintf (codf, ";\n");
	(void)fprintf (codf, "    M->ent = %d;\n", next_entry);
	GOTO_AGAIN;

	(void)fprintf (codf, "  case %d: {\n", i+n+product);
	annot = annot->brothers;
      }

      annot_type = NO_ANNOT;
      genlbm (h[2]);
    }
    break;

  case _gate_choice_exp_1 :
    (void)fprintf (codf, "-- Tree bad transformed\n");
    (void)fprintf (stderr, "Tree bad transformed\n");
    exit (1);
    break;

  case _par_exp_full_synch_1 :
    (void)fprintf (codf, "-- Tree bad transformed\n");
    (void)fprintf (stderr, "Tree bad transformed\n");
    exit (1);
    break;

  case _par_exp_inter_1 :
    (void)fprintf (codf, "-- Tree bad transformed\n");
    (void)fprintf (stderr, "Tree bad transformed\n");
    exit (1);
    break;

  case _par_exp_expli_1 :
    (void)fprintf (codf, "-- Tree bad transformed\n");
    (void)fprintf (stderr, "Tree bad transformed\n");
    exit (1);
    break;

  case _hiding_exp_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[2] != NULL)
      print_delay_wait (r, h[2]);

    ilist = (INTlist)takeclr (c_gate_decl, r);   /* Auxiliar */
    (void)fprintf (codf, "    b = mkhd (b, %d);\n",
		   (int)takeclr (c_entry, h[1]));

    (void)fprintf (codf, "    gts = b->fth->gte;\n");

    for ( ; ilist != NULL; ilist = INTtail (ilist))
      (void)fprintf (codf, "    gts[%d] = TRUE;\n",
		     INTpos (INThead (ilist), gate_decl_list));

    (void)fprintf (codf, "    M = b->frm;\n\n");
    annot_type = c_c;
    genlbm (h[2]);
    annot_type = NO_ANNOT;
    genlbm (h[1]);

    break;

  case _enable_exp_1 :
    h[0]= r;
    heval (h[0], h);
    {
      INTlist vlist = NULL;
      int len = 0;

      if (h[3] != NULL)
	print_delay_wait (r, h[3]);

      if (find_attr (c_var_list, r) != NULL) {
	vlist = (INTlist)takeclr (c_var_list, r);
	len = INTlength (vlist);
	if (len > max_accepted)
	  max_accepted = len;
	if (!debug_code)
	  var_decl_list = (INTlist)takeclr (c_var_decl_list, h[1]);
      }
      (void)fprintf (codf, "    b = mken (b, %d, %d, %d);\n",
		     (int)takeclr (c_entry, h[1]),
		     (int)takeclr (c_entry, h[2]), len);

      (void)fprintf (codf, "    vrs = b->fth->rav;\n");
      for (i = 0; vlist != NULL; i++, vlist = INTtail (vlist)) {
	(void)fprintf (codf, "    vrs[%d] = %d;\n", i,
		       cvarpos (INThead (vlist), var_decl_list));
      }
      GOTO_AGAIN;

      begin_entry (h[1]);
      genlbm (h[1]);
      begin_entry (h[2]);
      genlbm (h[2]);
      genlbm (h[3]);
    }
    break;

  case _disable_exp_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[3] != NULL)
      print_delay_wait (r, h[3]);

    (void)fprintf (codf, "    mkdis (b, %d, %d);\n",
		   (int)takeclr (c_entry, h[1]),
		   (int)takeclr (c_entry, h[2]));
    (void)fprintf (codf, "    c%d (b->sons);\n", crt);
    (void)fprintf (codf, "    b = b->sons->bth;\n");
    GOTO_AGAIN;

    begin_entry (h[1]);
    genlbm (h[1]);
    begin_entry (h[2]);
    genlbm (h[2]);
    genlbm (h[3]);

    break;

  case _parallel_full_synch_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[3] != NULL)
      print_delay_wait (r, h[3]);

    (void)fprintf (codf, "    mkps (b, %d, %d);\n",
		   (int)takeclr (c_entry, h[1]),
		   (int)takeclr (c_entry, h[2]));
    (void)fprintf (codf, "    c%d (b->sons);\n", crt);
    (void)fprintf (codf, "    b = b->sons->bth;\n");
    GOTO_AGAIN;

    begin_entry (h[1]);
    genlbm (h[1]);
    begin_entry (h[2]);
    genlbm (h[2]);
    genlbm (h[3]);

    break;

  case _parallel_interleaving_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[3] != NULL)
      print_delay_wait (r, h[3]);

    (void)fprintf (codf, "    mkpi (b, %d, %d);\n",
		   (int)takeclr (c_entry, h[1]),
		   (int)takeclr (c_entry, h[2]));
    (void)fprintf (codf, "    c%d (b->sons);\n", crt);
    (void)fprintf (codf, "    b = b->sons->bth;\n");
    GOTO_AGAIN;

    begin_entry (h[1]);
    genlbm (h[1]);
    begin_entry (h[2]);
    genlbm (h[2]);
    genlbm (h[3]);

    break;

  case _parallel_explicit_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[3] != NULL)
      print_delay_wait (r, h[3]);

    ilist = (INTlist)takeclr (c_gate_list, r);  /* Auxiliar */

    (void)fprintf (codf, "    mkpe (b, %d, %d);\n",
		   (int)takeclr (c_entry, h[1]),
		   (int)takeclr (c_entry, h[2]));
    (void)fprintf (codf, "    gts = b->gte;\n");

    for ( ; ilist != NULL; ilist = INTtail (ilist))
      (void)fprintf (codf, "    gts[%d] = TRUE;\n",
		     INTpos (INThead (ilist), gate_decl_list));

    (void)fprintf (codf, "    c%d (b->sons);\n", crt);
    (void)fprintf (codf, "    b = b->sons->bth;\n");
    GOTO_AGAIN;

    begin_entry (h[1]);
    genlbm (h[1]);
    begin_entry (h[2]);
    genlbm (h[2]);
    genlbm (h[3]);

    break;

  case _choice_exp_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[3] != NULL)
      print_delay_wait (r, h[3]);

    (void)fprintf (codf, "    mkch (b, %d, %d);\n",
		   (int)takeclr (c_entry, h[1]),
		   (int)takeclr (c_entry, h[2]));
    (void)fprintf (codf, "    c%d (b->sons);\n", crt);
    (void)fprintf (codf, "    b = b->sons->bth;\n");
    GOTO_AGAIN;

    begin_entry (h[1]);
    genlbm (h[1]);
    begin_entry (h[2]);
    genlbm (h[2]);
    genlbm (h[3]);

    break;

  case _guard_exp_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int iscte1, iscte2;    /* Indicate which value_exp are constants */

      if (h[4] != NULL)
	print_delay_wait (r, h[4]);

      iscte1 = is_cte_ve (r->sons);
      iscte2 = is_cte_ve (r->sons->brothers);
      if (iscte1 || iscte2)
	(void)fprintf (codf, "    {\n");
      if (iscte1)
	(void)fprintf (codf, "    static value x1 = NULL;\n");
      if (iscte2)
	(void)fprintf (codf, "    static value x2 = NULL;\n");
      if (iscte1 && iscte2)
	(void)fprintf (codf, "\n");
      if (iscte1) {
	(void)fprintf (codf, "    if (x1 == NULL)\n");
	(void)fprintf (codf, "      x1 = ud_const (%d, (udatum)(",
		       id2ui (takeclr (c_sort, h[1])));
	genlbm (h[1]);
	(void)fprintf (codf, "));\n");
      }
      if (iscte2) {
	(void)fprintf (codf, "    if (x2 == NULL)\n");
	(void)fprintf (codf, "      x2 = ud_const (%d, (udatum)(",
		       id2ui (takeclr (c_sort, h[2])));
	genlbm (h[2]);
	(void)fprintf (codf, "));\n");
      }

      (void)fprintf (codf, "    if (! ud_gequal (%d, ",
		     id2sort (takeclr (c_idref, h[1])));
      if (iscte2)
	(void)fprintf (codf, "x2, ");
      else {
	(void)fprintf (codf, "(udatum)(");
	genlbm (h[2]);
	(void)fprintf (codf, "),\n\t\t");
      }
      if (iscte1)
	(void)fprintf (codf, "x1");
      else {
	(void)fprintf (codf, "(udatum)(");
	genlbm (h[1]);
	(void)fprintf (codf, ")");
      }
      (void)fprintf (codf, ", 3)) {\n"); /* 3 = Free both */
      (void)fprintf (codf, "      mkst (b);\n");
      (void)fprintf (codf, "      break;\n    }\n");
      flag_grd++;
      if (iscte1 || iscte2)
	(void)fprintf (codf, "    }\n");

      genlbm (h[3]);
    }
    break;

  case _external_offer_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int n, number_exp = 0, predicate = -1, product = 1;

      sort_list_exp = NULL;
      if (h[1] != NULL)
	sort_list_exp = (INTlist)takeclr (c_sort_list, h[1]);
      if (h[4] != NULL) {
	print_delay_wait (r, h[4]);
	n = (int)takeclr (c_entry, r) + 1; /* De momento o delay o wait */
      }
      else
	n = (int)takeclr (c_entry, r);

      if (h[1] != NULL) {
	if (!debug_code)
	  var_decl_list = (INTlist)takeclr (c_var_decl_list, h[3]);
	number_exp = (int)takeclr (c_number_exp, h[1]);
	product = (int)takeclr (c_product, h[1]);
      }
      if (number_exp > max_exp)
	max_exp = number_exp;
      if (h[2] != NULL)
	predicate = (int)takeclr (c_pred_number, h[2]);
      if (product > 1) {
	print_mkch (n, product);
	print_mkads (h, n, product);
      }
      else {
	annot_type = c_default;
	genlbm (h[1]);
      }

      (void)fprintf (codf, "    mkad (b, %d, %d, %d, %d, %d, %s);\n",
		     (int)takeclr (c_entry, h[3]),
		     INTpos ((int)takeclr (c_gate_id, r),
			     gate_decl_list),
		     number_exp, (int)takeclr (c_sort_code, r),
		     predicate, search_priority (h[4]));
      BREAK_END_ENTRY;
      begin_entry (h[3]);
      annot_type = c_c;
      genlbm (h[4]);
      annot_type = NO_ANNOT;
      genlbm (h[3]);
    }
    break;

  case _internal_action_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[2] != NULL)
      print_delay_wait (r, h[2]);

    (void)fprintf (codf, "    mki (b, %d, %s);\n",
		   (int)takeclr (c_entry, h[1]), search_priority (h[2]));

    BREAK_END_ENTRY;
    begin_entry (h[1]);
    annot_type = c_c;
    genlbm (h[2]);
    annot_type = NO_ANNOT;
    genlbm (h[1]);

    break;

  case _stop_exp_1 :
    h[0]= r;
    heval (h[0], h);

    if (h[1] != NULL)
      print_delay_wait (r, h[1]);

    (void)fprintf (codf, "    mkst (b);\n");
    BREAK_END_ENTRY;
    break;

  case _exit_exp_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int number_exp = 0;

      if (h[2] != NULL)
	print_delay_wait (r, h[2]);

      if (!debug_code)
	if (h[1] != NULL)
	  var_decl_list = INTappend (var_decl_list,
				     (INTlist)takeclr (c_decl_var, h[1]));
	else
	  var_decl_list = (INTlist)takeclr (c_var_decl_list, r);

      genlbm (h[1]);

      if (h[1] != NULL)
	number_exp = (int)takeclr (c_number_off, h[1]);
      if (number_exp > max_exp)
	max_exp = number_exp;
      (void)fprintf (codf, "    mkex (b, %d, %d, %s);\n",
		     number_exp, (int)takeclr (c_sort_code, r),
		     search_priority (h[2]));

      BREAK_END_ENTRY;
    }
    break;

  case _BUT_instantiation_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int nvals = 0, nbut, length;
      INTlist totalvar;

      if (h[2] != NULL)
	print_delay_wait (r, h[2]);

      if (find_attr (c_gate_list, r) != NULL) {
	ilist = (INTlist)takeclr (c_gate_list, r);
	if (need_relabel (ilist)) {
	  i = INTlength (ilist);
	  for ( ; ilist != NULL; ilist = INTtail (ilist))
	    (void)fprintf (codf, "    push_gte (%d);\n",
			   INTpos (INThead (ilist), gate_decl_list));
	  (void)fprintf (codf, "    b = mkre (b, %d);\n", i);
	}
      }

      nbut = id2ui (takeclr (c_BUT_number, r));

      if (h[1] != NULL)
	nvals = (int)takeclr (c_number_var, h[1]);

      genlbm (h[1]);

      if (debug_code) {
	totalvar = var_decl_list;
	length = INTlength (var_decl_list);
      }
      else {
	totalvar = INTappend (paramtbl[crt], var_decl_list);
	length = INTlength (paramtbl[crt]) + vslength (tvs[crt]);
      }
      switch (length) {
      case 0 : break;
      case 1 :
	  /* var declared in other branches */
	  /* have no effect in the current one */
	if (totalvar != NULL) {
	  (void)fprintf (codf, "    if (M->rav[0] != NULL) {\n");
	  (void)fprintf (codf, "      ud_free (%d, M->rav[0]);\n",
			 id2sort ((CLR_TYPE)INThead (totalvar)));
	  (void)fprintf (codf, "      M->rav[0] = NULL;\n");
	  (void)fprintf (codf, "    }\n");
	}
	break;
      default :
	(void)fprintf (codf, "    for (i = 0; i < %d; i++)\n", length);
	(void)fprintf (codf, "      if (M->rav[i] != NULL) {\n");
	(void)fprintf (codf,
		       "        ud_free (TSsorts[%d][i], M->rav[i]);\n",
		       crt);
	(void)fprintf (codf, "        M->rav[i] = NULL;\n");
	(void)fprintf (codf, "      }\n");
	break;
      }

      switch (nvals) {               /* It is easy to expand the 'for'. */
      case 0 : break;                /* When defined, it was set to 0.  */
      case 1 :
	(void)fprintf (codf, "    M->rav[0] = v[0];\n");
	(void)fprintf (codf, "    v[0] = NULL;\n");
	(void)fprintf (codf, "    assert (M->rav[0] != NULL);\n");
	break;
      default:
	(void)fprintf (codf, "    for (i = 0; i < %d; i++) {\n", nvals);
	(void)fprintf (codf, "      M->rav[i] = v[i];\n");
	(void)fprintf (codf, "      v[i] = NULL;\n");
	(void)fprintf (codf, "      assert (M->rav[i] != NULL);\n");
	(void)fprintf (codf, "    }\n");
      }

      (void)fprintf (codf, "    M->ent = 0;\n");
      if (crt == nbut) {
	GOTO_AGAIN;
      }
      else {
	(void)fprintf (codf, "    M->but = %d;\n", nbut);
	(void)fprintf (codf, "    c%d (b);\n", nbut);
	BREAK_END_ENTRY;
      }
    }
    break;

  case _relabel_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int last_gte = 0;
      INTlist auxl = NULL;

      assert (find_attr (c_gate_decl, r) != NULL);
      ilist = (INTlist)takeclr (c_gate_decl, r);
      if (need_relabel (ilist)) {
	last_gte = INTpos (INTmax (ilist), gate_decl_list);
	for (i = 0, auxl = gate_decl_list;
	     i < last_gte;
	     i++, auxl = INTtail (auxl)) {
	  assert (auxl != NULL);
	  if (INTIsIn (INThead (auxl), ilist))
	    (void)fprintf (codf, "    push_gte (%d);\n",
			   INTpos (gte_relabeled (INThead (auxl), r),
				   gate_decl_list));
	  else
	    (void)fprintf (codf, "    push_gte (%d);\n", i + 1);
	}
	(void)fprintf (codf, "    b = mkre (b, %d);\n", i);
      }
      (void)fprintf (codf, "    M->ent = %d;\n", (int)takeclr (c_entry, h[1]));
      (void)fprintf (codf, "    M = b->frm;\n\n");

      genlbm (h[1]);
    }
    break;

  case _call_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int cnt, nbut, nvals = 0, length;
      INTlist totalvar;

      if (find_attr (c_gate_list, r) != NULL) {
	ilist = (INTlist)takeclr (c_gate_list, r);
	if (need_relabel (ilist)) {
	  i = INTlength (ilist);
	  for ( ; ilist != NULL; ilist = INTtail (ilist))
	    (void)fprintf (codf, "    push_gte (%d);\n",
			   INTpos (INThead (ilist), gate_decl_list));
	  (void)fprintf (codf, "    b = mkre (b, %d);\n", i);
	}
      }

      if (find_attr (c_var_list, r) != NULL) {
	ilist = (INTlist)takeclr (c_var_list, r);
	nvals = INTlength (ilist);
	for (cnt = 0; ilist != NULL; ilist = INTtail (ilist), cnt++) {
	  (void)fprintf (codf, "    v[%d] = ud_copy (%d, M->rav[%d]);\n",
			 cnt, id2sort ((CLR_TYPE)INThead (ilist)),
			 cvarpos (INThead (ilist), var_decl_list));
	}
      }

      if (debug_code) {
	totalvar = var_decl_list;
	length = INTlength (var_decl_list);
      }
      else {
	totalvar = INTappend (paramtbl[crt], var_decl_list);
	length = INTlength (paramtbl[crt]) + vslength (tvs[crt]);
      }
      switch (length) {
      case 0 : break;
      case 1 :
	  /* var declared in other branches */
	  /* have no effect in the current one */
	if (totalvar != NULL) {
	  (void)fprintf (codf, "    if (M->rav[0] != NULL) {\n");
	  (void)fprintf (codf, "      ud_free (%d, M->rav[0]);\n",
			 id2sort ((CLR_TYPE)INThead (totalvar)));
	  (void)fprintf (codf, "      M->rav[0] = NULL;\n");
	  (void)fprintf (codf, "    }\n");
	}
	break;
      default :
	(void)fprintf (codf, "    for (i = 0; i < %d; i++)\n", length);
	(void)fprintf (codf, "      if (M->rav[i] != NULL) {\n");
	(void)fprintf (codf,
		       "        ud_free (TSsorts[%d][i], M->rav[i]);\n",
		       crt);
	(void)fprintf (codf, "        M->rav[i] = NULL;\n");
	(void)fprintf (codf, "      }\n");
	break;
      }

      switch (nvals) {               /* It is easy to expand the 'for'. */
      case 0 : break;                /* When defined, it was set to 0.  */
      case 1 :
	(void)fprintf (codf, "    M->rav[0] = v[0];\n");
	(void)fprintf (codf, "    v[0] = NULL;\n");
	(void)fprintf (codf, "    assert (M->rav[0] != NULL);\n");
	break;
      default:
	(void)fprintf (codf, "    for (i = 0; i < %d; i++) {\n", nvals);
	(void)fprintf (codf, "      M->rav[i] = v[i];\n");
	(void)fprintf (codf, "      v[i] = NULL;\n");
	(void)fprintf (codf, "      assert (M->rav[i] != NULL);\n");
	(void)fprintf (codf, "    }\n");
      }

      nbut = id2ui (takeclr (c_BUT_number, r));
      (void)fprintf (codf, "    M->ent = 0;\n");
      (void)fprintf (codf, "    M->but = %d;\n", nbut);
      (void)fprintf (codf, "    c%d (b);\n", nbut);

      BREAK_END_ENTRY;
    }
    break;

  case _var_domain_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    (void)fprintf (codf, "-- Wrong node\n");
    (void)fprintf (stderr, "Wrong node\n");
    exit (1);
    break;

  case _gate_domain_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    (void)fprintf (codf, "-- Wrong node\n");
    (void)fprintf (stderr, "Wrong node\n");
    exit (1);
    break;

  case _gate_domain_1 :
    h[0]= r;
    heval (h[0], h);
    (void)fprintf (codf, "-- Wrong node\n");
    (void)fprintf (stderr, "Wrong node\n");
    exit (1);
    break;

  case _predicate_1 :
    h[0]= r;
    heval (h[0], h);
    {
      TNODE *e_l = NULL;     /* experiment_list */
      int iscte1, iscte2;    /* Indicate which value_exp are constants */

      e_l = gt_lb (r);
      assert ((e_l != NULL) && (e_l != r));
      local_var_decl = (INTlist)takeclr (c_local_var_decl, r);
      value_exp_used = (INTlist)takeclr (c_value_exp_used, r);
      iscte1 = is_cte_ve (r->sons);
      iscte2 = is_cte_ve (r->sons->brothers);
      if (iscte1)
	(void)fprintf (codf, "  static value x1 = NULL;\n");
      if (iscte2)
	(void)fprintf (codf, "  static value x2 = NULL;\n");
      if (iscte1 && iscte2)
	(void)fprintf (codf, "\n");
      if (iscte1) {
	(void)fprintf (codf, "  if (x1 == NULL)\n");
	(void)fprintf (codf, "    x1 = ud_const (%d, (udatum)(",
		       id2ui (takeclr (c_sort, h[1])));
	genlbm (h[1]);
	(void)fprintf (codf, "));\n");
      }
      if (iscte2) {
	(void)fprintf (codf, "  if (x2 == NULL)\n");
	(void)fprintf (codf, "    x2 = ud_const (%d, (udatum)(",
		       id2ui (takeclr (c_sort, h[2])));
	genlbm (h[2]);
	(void)fprintf (codf, "));\n");
      }
      for (i = 0, ilist = local_var_decl;
	   ilist != NULL;
	   i++, ilist = INTtail (ilist))
	if (IsInNode (INThead(ilist), r))              /* VARPOS!! */
	  (void)fprintf (codf, "  if (xto[%d] == NULL) return PRD_NRDY;\n",
			 varpos (INThead (ilist), value_exp_used));

      (void)fprintf (codf, "  return ud_gequal (%d, ",
		     id2sort (takeclr (c_idref, h[1])));

      if (iscte2)
	(void)fprintf (codf, "x2, ");
      else {
	(void)fprintf (codf, "(udatum)(");
	genlbm (h[2]);
	(void)fprintf (codf, "),\n\t\t");
      }
      if (iscte1)
	(void)fprintf (codf, "x1");
      else {
	(void)fprintf (codf, "(udatum)(");
	genlbm (h[1]);
	(void)fprintf (codf, ")");
      }

      (void)fprintf (codf, ", 3);\n"); /* Free both */
      local_var_decl = NULL;
    }
    break;

  case _ident_equation_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    {
      TNODE *taux = NULL;

      for (taux = gt_fs (r);
	   taux != NULL;
	   taux = gt_rb (taux))
	genlbm (taux);
    }
    break;

  case _ident_equation_1 :
    h[0]= r;
    heval (h[0], h);
    {
      INTlist vlist = NULL;

      for (vlist = (INTlist)takeclr (c_var_list, r);
	   vlist != NULL;
	   vlist = INTtail (vlist)) {
	(void)fprintf (codf, "    M->rav[%d] = (udatum)",
		       cvarpos (INThead (vlist), var_decl_list));
	genlbm (h[1]);
	(void)fprintf (codf, ";\n");
      }
    }
    break;

  case _experiment_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    {
      TNODE *taux = NULL;
      int id, srt;

      for (taux = gt_fs (r);
	   taux != NULL;
	   taux = gt_rb (taux)) {
	assert ((taux->type == tvalue_exp) || (taux->type == tvar_id));
	if (taux->type == tvalue_exp) {
	  id = (int)takeclr (c_idref, taux);
	  if (idclass (id) == TOPN) {
	    (void)fprintf (codf, "    mkso ((udatum)");
	    genlbm (taux);
	    (void)fprintf (codf, ");\n");
	  }
	  else if (idclass (takeclr (c_idref, taux)) == TVAL) {
	    srt = id2sort ((CLR_TYPE)id);
	    (void)fprintf (codf, "    mkso (ud_copy (%d, M->rav[%d]));\n",
			   srt, cvarpos (id, var_decl_list));
	  }
	  else fatal_error ("wrong idclass", __FILE__, __LINE__);
	}
	else
	  genlbm (taux);
      }
    }
    break;

  case _var_id_1 :
    h[0]= r;
    heval (h[0], h);
    {
      int var_id;

      var_id = (int)takeclr (c_var_id, r);
      if (hay_color (c_default, h[1])) {
	(void)fprintf (codf, "    mkdef (%d, ud_copy (%d, (udatum)(",
		       cvarpos (var_id, var_decl_list),
		       id2sort ((CLR_TYPE)var_id));
	annot_type = c_default;
	genlbm (h[1]);
	annot_type = NO_ANNOT;
	(void)fprintf (codf, ")));\n");
      }
      else if (hay_color (c_eval, h[1])) {
	(void)fprintf (codf, "    mkeval (%d, ",
		       cvarpos (var_id, var_decl_list));
	annot_type = c_eval;
	genlbm (h[1]);
	annot_type = NO_ANNOT;
	(void)fprintf (codf, ");\n");
      }
      else if (hay_color (c_use, h[1])) {
	(void)fprintf (codf, "    mkuse ((udatum)");
	annot_type = c_use;
	genlbm (h[1]);
	annot_type = NO_ANNOT;
	(void)fprintf (codf, ", %d);\n", cvarpos (var_id, var_decl_list));
      }
      else
	(void)fprintf (codf, "    mkmo (%d);\n",
		       cvarpos (var_id, var_decl_list));
    }
    break;

  case _value_exp_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    {
      int   id, cnt = 0;
      TNODE *taux = NULL;

      for (taux = gt_fs (r); taux != NULL; taux = gt_rb (taux)) {
	if (idclass (takeclr (c_idref, taux)) == TOPN) {
	  (void)fprintf (codf, "    v[%d] = (udatum)", cnt++);
	  genlbm (taux);
	  (void)fprintf (codf, ";\n");
	}
	else if (idclass (takeclr (c_idref, taux)) == TVAL) {
	  id = identifier (taux);
	  (void)fprintf (codf, "    v[%d] = ud_copy (%d, M->rav[%d]);\n",
			 cnt++, id2sort ((CLR_TYPE)id),
			 cvarpos (id, var_decl_list));
	}
	else fatal_error ("wrong idclass", __FILE__, __LINE__);
      }
    }
    break;

  case _value_exp_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    {
      TNODE *taux = NULL;
      int id, sort, ext;

      id = (int)takeclr (c_idref, r);
      sort = id2sort ((CLR_TYPE)id);
      if (idclass (id) == TOPN) {
	if ((ATfind (ATable, id, c_call) == NULL) &&
	    (ATfind (ATable, id, c_name) != NULL))
	  (void) fprintf (codf, "%s (",
			  (char*)ATfind (ATable, id, c_name)->value);
	else
	  (void) fprintf (codf, "g%d (", id2ui ((CLR_TYPE)id));
	for (taux = gt_fs (r); taux != NULL; taux = gt_rb (taux)) {
	  genlbm (taux);
	  if (taux->brothers != NULL)
	    (void)fprintf (codf, ", "); /* to separate the arguments */
	}
	(void)fprintf (codf, ")");
      }
      else {
	ext = IsExtVar (id);
	if (ext)
	  (void)fprintf (codf, "ud_copy (%d, ", sort);
	else
	  (void)fprintf (codf, "kd_copy ((kdatum)");
	if (pred_flag)
	  if (INTIsIn (id, local_var_decl)) {
	    (void)fprintf (codf, "xto[%d])",
			   varpos (id, value_exp_used)); /* VARPOS!! */
	  }
	  else
	    (void)fprintf (codf, "M->rav[%d])",
			   cvarpos (id, var_decl_list));
	else
	  (void)fprintf (codf, "M->rav[%d])",
			 cvarpos (id, var_decl_list));
      }
    }
    break;

  case _annotation_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    {
      TNODE *taux = NULL;

      for (taux = gt_fs (r);
	   taux != NULL;
	   taux = gt_rb (taux))
	genlbm (taux);
    }
    break;

  case _annotation_1 :
    h[0]= r;
    heval (h[0], h);

    if (pred_flag) {
      annot_type = c_wait;
      assert (find_attr (c_wait, r) != NULL);
      (void)fprintf (codf, "  return ");
      translate_annot (r, FALSE);
      (void)fprintf (codf, ";\n");
      annot_type = NO_ANNOT;
    }
    else {
      if (find_attr (annot_type, r) != NULL)
	switch (annot_type) {
	case c_wait :
	  set_attr (c_this_BUT_ui, r, (CLR_TYPE)crt);
	  (void)fprintf (codf, "%d", ITadd ((int)r, pred_tbl));
	  break;
	case c_default :
	case c_use :
	  translate_annot (r, TRUE);
	  break;
	case c_delay :
	case c_if :
	  translate_annot (r, FALSE);
	  break;
	case c_c :
	  print_line (codf, r);
	  translate_annot (r, TRUE);
	  (void)fprintf (codf, "\n");
	  break;
	case c_eval :
	  (void)fprintf (codf, "%d", STadd ((char*)takeclr (annot_type, r),
					    eval_tbl, 1));
	  break;
	case c_lbc :
	  if (lbc_before) {
	    print_line (incf, r);
	    (void)fprintf (incf, "%s\n", (char*)takeclr (annot_type, r));
	  }
	  else {
	    print_line (codf, r);
	    (void)fprintf (codf, "%s\n", (char*)takeclr (annot_type, r));
	  }
	  break;
	default :
	  translate_annot (r, FALSE);
	  (void)fprintf (codf, "\n");
	  break;
      }
    }
    break;

  case _exit_offer_list_1 :
    h[0]= r;
    h[1]= gt_fs (h[0]);
    h[5]= gt_ls (h[0]);
    {
      TNODE *taux = NULL;
      int srt;

      for (taux = gt_fs (r);
	   taux != NULL;
	   taux = gt_rb (taux)) {
	assert ((taux->type == tvalue_exp) || (taux->type == tsort_id));
	if (taux->type == tvalue_exp) {
	  if (idclass (takeclr (c_idref, taux)) == TOPN) {
	    (void)fprintf (codf, "    mkso ((udatum)");
	    genlbm (taux);
	    (void)fprintf (codf, ");\n");
	  }
	  else if (idclass (takeclr (c_idref, taux)) == TVAL) {
	    srt = id2sort ((CLR_TYPE)identifier (taux));
	    (void)fprintf (codf, "    mkso (ud_copy (%d, M->rav[%d]));\n",
			   srt, cvarpos (identifier (taux), var_decl_list));
	  }
	  else fatal_error ("wrong idclass", __FILE__, __LINE__);
	}
	else
	  (void)fprintf (codf, "    mkmo (0);\n");
      }
    }
    break;

  case _sort_id_1 :
    h[0]= r;
    heval (h[0], h);
    (void)fprintf (codf, "-- Wrong node\n");
    (void)fprintf (stderr, "Wrong node\n");
    exit (1);
    break;
  }
}

PUBLIC void
gencode ()
{
  if (split_flag) {
    if (split_parts > lastBUTnumber)
      split_parts = lastBUTnumber; /* At least, 1 corroutine per file */
    but_per_part = lastBUTnumber / split_parts;
    but_redundant = lastBUTnumber % split_parts;
    if (but_redundant != 0)
      but_per_part++;
    else
      but_redundant = -1;
  }

  genfilenames ();

  incf = efopen (incname, "w");
  codf = efopen (codename, "w");

  eval_tbl = STcreate (100, 10, 0, TRUE);
  TSprocess = (char**)emalloc ((lastBUTnumber)*sizeof (char*));
  TSgates = (INTlist*)emalloc ((lastBUTnumber)*sizeof (INTlist));
  TSvars = (INTlist*)emalloc ((lastBUTnumber)*sizeof (INTlist));
  /*
  used_var_tbl = create_uvt ();
  init_uvt (lbmroot);
  */
  gate_decl_list = NULL;
  var_decl_list  = NULL;
  local_var_decl = NULL;
  pred_flag = FALSE;
  uptvs_position ();

  genlbm (lbmroot);
  print_predicates ();
  print_tables ();

  (void)fclose (codf);
  (void)fclose (incf);
}

