/*  MODULE  :   genstm.c
 *              generate  C-code
 *
{*  last modification:	22.10.92  14:17   }


 * uli 19.11.90 : genexpr now generates "->"
 * uli 19.11.90 : cTemptype  added
 * uli 22.11.90 : [ ] substituted by  cLBrack cRBrack
 * uli 27.11.90 : cUntemp  added
 * uli 28.11.90 : gencase corrected
 * uli 03.01.91 : REPEAT: eline generated before "} while"
 * uli 04.01.91 : prototypes added.
 * uli 25.02.91 : genline indents now, finmerge checks tabs now
 * uli 26.02.91 : arg_expr: test for cRout added.
 * uli 06.03.91 : l_struct_decl checks NIL.
 * uli 06.03.91 : requesting "hasdyn or imported",
		   ! has to be corrected in export.c and import.c
 *     04.04.91 : call of a_ppsh instead of assignment to global pointer.
 *     04.04.91 : declaration of array of pointer now correct.
 * uli 15.04.91 : genstring is global now.
 * uli 16.04.91 : dskerror added.
 * uli 23.04.91 : rounded real constant cLParD and cLParU added.
 * uli 03.05.91 : cFree  added
 * uli 03.05.91 : genstm: There may be a semicolon list  left side of WHILE
 * uli 13.05.91 : genexpr: cPCast added.
 * uli 29.05.91 : cAssign:  y_desc*  replaced by  y_dscp .
 * uli 26.06.91 : cArrow :  variable may be left or right son.
 * uli 08.07.91 : arg_expr : idlevel checked before access thru disp_index
 * uli 09.07.91 : a_cpsh generated only if disp_level>0
 * uli 18.07.91 : cast to (a_VOID) suppresses warnings of some C compilers
 *     19.08.91 : "and (disp_level>0)" erased in genexpr.
 *     19.08.91 : Declaration of arg_expr added.
 *     21.08.91 : generated --> nodecl.
 * uli 14.11.91 : genchar : "or=='?'" deleted.
		  genstring : "??" generates "?\?"
 * uli 09.12.91 : dir_decl : nodecl-flag set.
		  gende_spec : "struct" generated only if not nodecl-flag.
 * uli 09.12.91 : dir_decl : "defined " added.
 * uli 16.12.91 : genstring handles NULL string now.
 * uli 18.12.91 : gende_spec : "struct" generated if not imported-flag.
 * uli 14.02.92 : dir_decl: defined = false if body is detached.
 * uli 17.02.92 : cFOR: on_fastfor added.
 * Dima 22.10.92: genstm: Initialization of cDynamic is added for NEW
*/


#undef  Error_Seek

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include           "impor.t"

#include "error.h"
#include "option.h"
#include "scan.h"
#include "symtab.h"
#include "idtab.h"
#include "optab.h"
#include "blktab.h"
#include "bintab.h"
#include "sysutil.h"
#include "module.h"
#include "std.h"
#include "generate.h"

#include           "expor.t"
#include "genstm.h"

#include           "implemen.t"


#ifdef LINT_ARGS

local   void    l_struct_decl (binptr);
local   void    arg_expr      (binptr);
local   void    arg_expr_list (binptr);
local   boolean s_decl      (binptr, binptr);
local   boolean s_typ       (binptr, binptr);
local   boolean genpname    (binptr, binptr);
local   void    l_declarator(binptr, binptr);
local   void    genrettyp   (binptr);
local   void    genpara     (binptr, binptr);
local   void    genanw      (binptr p);
local   void    gencase     (binptr p);
local   void    gentagfield (binptr);
local   void    dir_decl    (binptr, binptr);
local   void    declarator  (binptr, binptr);
local   void    genchar     (char);
local   longint getintval   (binptr p);
local   void    genelcase   (binptr p);

#else

local   void    l_struct_decl ();
local   void    arg_expr      ();
local   void    arg_expr_list ();
local   boolean s_decl      ();
local   boolean s_typ       ();
local   boolean genpname    ();
local   void    l_declarator();
local   void    genrettyp   ();
local   void    genpara     ();
local   void    genanw      ();
local   void    gencase     ();
local   void    gentagfield ();
local   void    dir_decl    ();
local   void    declarator  ();
local   void    genchar     ();
local   longint getintval   ();
local   void    genelcase   ();

#endif


local shortint  srcline = 0 ;  /* last source line merged */
local shortint  tilline = 0 ;  /* source until this line must be merged */
local int       col=0;
local int       tabs=0;

						  /*-----------------*/
#ifdef LINT_ARGS
local boolean genpname  (  binptr bin,binptr dummy)
#else
local boolean genpname (bin, dummy)               /* g e n p n a m e */
/* Generate name of parameter.
*/
binptr bin;     /* name of parameter. */
binptr dummy;   /* Not used. */
#endif
{

    if ( binsymc (bin)==cFUNCTION )
       genCid (binleft (binleft (bin)));
    else if ( binsymc (bin)==cPROCEDURE )
       genCid (binleft (bin));
    else
       genCid (bin);

    return true;
} /* genpname */


#ifdef LINT_ARGS
local void genpara  (  binptr rout, binptr typ)
#else
local void genpara (rout, typ)
/* Generate argument-list in old-style fashion:
 *        ...(id, id, ...)
 *        typ id;
 *        typ id;
 *        ...
 * p: rout.
*/
binptr   rout;
binptr   typ;
#endif
{
boolean isarrayres,
	isparused,
	oper,def;
binptr  plist;
    def = binsymc (binright (typ))==cBEGIN;
    oper = ( binsymc (typ)==cOPERATOR );
    if  ( oper ) {
      isarrayres = op_is(binop(rout),arraytype);
      isparused = false;
    } else {
      isarrayres = id_is(binid(rout),arraytype);
      isparused  = id_is(binid(rout),parused) or
		   id_is(binid(rout),formpara);
    }

    gen (" (");
    plist = binright(rout);

    mergtill (plist);

    if ( isarrayres ) {      /* Pointer to result is first parameter */
       if ( oper ) {
	  if ( on_prototyp )
	     gende_spec (binright (binright (binleft (typ))));
	  if ( def )
	     genCid (binright (binleft (typ)));
       } else { /* function */
	  if ( on_prototyp )
	     gende_spec (binright (binleft (typ)));
	  if ( def )
	     gen (symtab(symresid));
       }
    }

    if ( plist ) {
       if ( isarrayres and
	     (on_prototyp or def) ) gen (",");

       if ( on_prototyp and not def )
	  para_trav (plist ,s_typ, 1);
       else
       if ( def and not on_prototyp )
	  para_trav (plist ,genpname, 1);
       else
       if ( def and on_prototyp )
	  para_trav (plist ,s_decl, 1);
    }

    if ( not isarrayres and not plist and on_prototyp )
       gen ("void");

    gen (")");

    if ( def and not on_prototyp ) {
       genline ();
       if ( isarrayres ) {      /* Pointer to result is first parameter */
	  if ( oper ) {
		gende_spec (binright (binright (binleft (typ))));
		genCid (binright (binleft (typ)));
	  } else { /* function */
		gende_spec (binright (binleft (typ)));
		gen (symtab(symresid));
	  }
	  gen (";"); genline ();
       }

       para_trav (plist,s_decl, 2);
    }
}


						/*---------------*/
#ifdef LINT_ARGS
global boolean gentyp  ( binptr typ )
#else
global boolean gentyp (typ)                     /*  g e n t y p  */
binptr typ;
/*
 *  type-name
*/
#endif
{
    gende_spec (typ);                     /* declaration-specifiers */
    declarator (NIL,typ);                /* abstract-declarator */
    return true;
} /* gentyp */

					     /*-------------------*/
#ifdef LINT_ARGS
local void dir_decl  ( binptr id,binptr typ )
#else
local void dir_decl (id,typ)                /*  d i r _ d e c l  */
binptr id;
binptr typ;
/*
 *  direct-declarator
*/
#endif
{
   boolean func=false,funcpara=false, defined=true;
   binptr rout;

   if ( binsymc (typ)==cFUNCTION or
	binsymc (typ)==cPROCEDURE or
	binsymc (typ)==cOPERATOR  ) {
      if ( id==NULL ) {
	 if ( binsymc (typ)==cPROCEDURE ) rout=binleft (typ);
	 else rout=binleft(binleft(typ));
      } else rout=id;
      if ( id_is (binid (rout), formpara) ) {
	 gen ("(* ");
	 funcpara=true;
      }
      else  defined = (binright(typ)!=NIL /* 14.02.92 */
                       and binsymc (binright(typ)) != cFORWARD) ;
      func=true;
   }

   if ( id ) genCid (id);

   if ( funcpara ) gen (")");

   if ( binsymc (typ) == cString ) {
      gen (symctext[cLBrack]);
      if (sym_is [binsymc(binright(typ))].value)
	  genint ((long) binvalue(binright(typ)));
      else genint ( 256L );
      gen (symctext[cRBrack]);
   }
   else if ( binsymc (typ) == cARRAY )
     do {
	gen (symctext[cLBrack]);
	genrange (binleft(typ));
	gen (symctext[cRBrack]);
	typ = binright(typ);
     } while (binsymc(typ) == cARRAY);
   else if ( func )
      genpara (rout,typ);

   if (defined and binid(id))   idfset(binid(id),nodecl); /* declarated! */
} /* dir_decl */


					      /*-----------------------*/
#ifdef LINT_ARGS
local void declarator  ( binptr bin,binptr typ )
#else
local void declarator (bin,typ)               /*  d e c l a r a t o r  */
binptr bin;
binptr typ;
/*
 *  declarator
*/
#endif
{
    idptr id=binid (bin);
    binptr eltyp = typ;

    while (binsymc(eltyp) == cARRAY)
       eltyp = binright(eltyp);

    while ( binsymc (eltyp) == cArrow ) {
       gen ("* ");                          /* pointer */
       eltyp=binright(eltyp);
    }                                       /* direct-declarator */

    if ( id and idgetkind (id)==IDVARPARAM and not
	 id_is (id,arraytype) )
	 gen ("* ");
    dir_decl (bin, typ);
} /* declarator */

#if 0
#ifdef LINT_ARGS
local void storage_class  ( binptr bin)
#else
local void storage_class (bin)
binptr bin;
#endif
{
   boolean is_global;
   binptr id=binleft (bin);

       if ( binsymc (bin)==cPROCEDURE or
	    binsymc (bin)==cFUNCTION ) {
	  if ( binsymc (bin)==cFUNCTION )
	     id=binleft (id);
	  is_global=id_is (binid (id), is_global);
       } else
       if ( binsymc (bin)==cOPERATOR ) {
	  id=binleft (id);
	  is_global=op_is (binop (id), is_global);
       }

       if (to_export (id) and dclfile)
	  gen ("global ");
       else
       if ( binsymc(binright(bin))==cEXTERNAL or is_global )
	  gen ("extern ");
       else gen ("static ");
}
#endif
					       /*---------------------*/
#ifdef LINT_ARGS
local void genrettyp ( binptr typ)
#else
local void genrettyp(typ)                      /*  g e n r e t t y p  */
binptr typ;
#endif
{
    if ( sym_is[binsymc(unname(typ))] .arraytype )
       gen ("a_VOID ");
    else gende_spec (typ);

} /* genrettyp */


						/*-----------------------*/
#ifdef LINT_ARGS
global void gende_spec  ( binptr typ )
#else
global void gende_spec (typ)                    /*  g e n d e _ s p e c  */
binptr typ;
/*
 *  declaration-specifiers
*/
#endif
{  binptr eltyp,list;
   char dim = 0;


   if ( sym_is [binsymc(typ)].identifier ) {
     if ( binsymc (unname (typ)) == cRECORD  and
	  not id_is(binid(typ), imported)    and
	  not id_is(binid(typ), nodecl) ) /* C name not yet declared */
	gen ("struct ");

     genCid (typ);
     gen (" ");
   }
   else switch ( binsymc (typ) ) {

      case cArrow :
	gende_spec (binright(typ));
	break;

      case cARRAY :
	eltyp = typ;
	repeat {
	    eltyp = binright(eltyp);
	} until (binsymc(eltyp) != cARRAY);
	gende_spec (eltyp);
      break;

      case cLParent : {
	  boolean first=true;
	  gen ("enum {");
	  inctabs (); genline ();
	  do {
	    typ=binright(typ);
	    if ( first ) first=false;
	    else { gen (","); genline (); }
	    genCid (typ);
	  } while (binsymc(binright(typ)) == cIdlist);
	  dectabs (); genline ();
	  gen ("} ");
      }
      break;

      case cRECORD :
	 gen ("struct ");

	 list=binfather (typ);
						     /* Tag-name is pascal- */
	 if (binsymc(list)==cTYPE and                /* type-name.          */
	     binsymc(list=binleft(list))!=cCsymbol   /* This tag-name is used */
	     and binsymc(list)!=cTemptype)

	    gen (symtab (idcsym (binid (list))));    /* in recursive referen- */
						     /* ces.                  */

    /* Generate tagfield to define structure. */
	  gen (" {");
	  inctabs ();
	  genline ();
	  gentagfield(typ);
	  dectabs ();
	  gen ("} ");
      break;

      case cSET :
	  gen ("s_etof ");

      break;

      case cFILE :
	  gen ("f_ilof(");
	  gende_spec (binright(typ));
	  gen (") ");
      break;

     case cDYNAMIC :
	  gen ("y_arof(");
	  eltyp = typ;
	  repeat {
	      eltyp = binright(unname(eltyp));
	      dim++;
	  } until (binsymc(unname(eltyp)) != cDYNAMIC);
	  gende_spec (eltyp);
	  gen (",");
	  genint ((long) dim);
	  gen (") ");
      break;

      case cTill :
	switch (binsymc(binleft(typ))) {
	  case cIcon : gen (symtab (idcsym (idINTEGER))); break;
	  case cCcon : gen (symtab (idcsym (idCHAR)));    break;
	  case cBcon : gen (symtab (idcsym (idBOOLEAN))); break;
	  default    : gen (symtab (idcsym (idINTEGER))); break;
	}
	gen (" ");
      break;

      case cFUNCTION:
	genrettyp (binright(binleft(typ))) ;       /* function result type */
      break;

      case cPROCEDURE:
	gen ("void ");
      break;

      case cOPERATOR:
	genrettyp (binright(binright(binleft(typ)))) ; /* Operator result type */
      break;

      case cTemptype :
      case cCsymbol :
	gen (symtab (binsym (typ)));
	gen (" ");
      break;

      default :
	if (not typ) break;
	gen (" #");
	gen (symptext[binsymc(typ)]);
	gen ("# ");

   }  /* switch  */

} /* gende_spec */


						    /*-------------------*/
#ifdef LINT_ARGS
global void gendecl ( binptr list,binptr typ )
#else
global void gendecl(list,typ)                       /*   g e n d e c l   */
binptr   list;
binptr   typ;
/*
 *  translation-unit (but no function-definition).
 *
*/
#endif
{
    while ( binsymc (list) == cSemicolon ) {
       if ( decl (binleft (list),typ) ) gen (";"); genline ();
       mergtill (typ);
       list=binright(list);
    }
    if ( decl (list,typ) ) gen (";"); genline ();

} /* gendecl */

#ifdef LINT_ARGS
local void  l_declarator  (  binptr list,binptr typ)
#else
local void  l_declarator (list, typ)
/*
 * init-declarator-list and struct-declarator-list.
 * l_declarator:
 *   declarator
 *   l_declarator, declarator
*/
binptr list;
binptr typ;
#endif
{
   boolean comma=false;
   if ( binsymc (list) == cIdlist or
	binsymc(list) == cCsymbol )
      do {
       if ( not ( binsymc (list) == cIdlist and
		  id_is (binid (list), nodecl)) ) {
	  if ( comma ) gen (", ");
	  else comma=true;
	  declarator (list,typ);
       }
       list = binright (list);
      } while ( binsymc(list) == cIdlist or binsymc(list) == cCsymbol);

   else
     declarator (list, typ);
}
						 /*-------------*/
#ifdef LINT_ARGS
local boolean s_typ ( binptr list,binptr typ )
#else
local boolean s_typ(list,typ)                    /*  s _ t y p  */
binptr list;
binptr typ;
/*
 *  declaration
*/
#endif
{
   boolean retcode;
   symptr symc;

   if ( list == NIL or binsymc (list)==cCsymbol )
      retcode = s_decl (NIL, typ);
   else {
      symc = idcsym (binid (list));
      idsetcsym (binid (list),symNIL);
      retcode = s_decl (list, typ);
      idsetcsym (binid (list),symc);
   }
   return retcode;
} /* s_typ */

						  /*---------------*/
#ifdef LINT_ARGS
local boolean s_decl ( binptr list,binptr typ )
#else
local boolean s_decl(list,typ)                    /*  s _ d e c l  */
binptr list;
binptr typ;
/*
 *  declaration
*/
#endif
{
   gende_spec (typ);

   declarator (list, typ);

   return true;
} /* s_decl */

						 /*-----------*/
#ifdef LINT_ARGS
global boolean decl ( binptr list,binptr typ )
#else
global boolean decl(list,typ)                    /*  d e c l  */
binptr list;
binptr typ;
/*
 *  declaration
*/
#endif
{
   binptr temp;

   if (list == NIL)   return false ; /* nothing to do */

   if ( binsymc(temp=list) == cIdlist ) {  /* 'list' is init-declarator- */
      boolean action=false;                /* list. Check for non-inner- */
      do {                                 /* used, therefore non-gene-  */
	 if ( not id_is (binid (temp), nodecl) )   /* rated variables */
	    action=true;
	 temp = binright (temp);
      } while ( binsymc(temp) == cIdlist and not action );
      if ( not action ) return false;      /* Nothing to do! */
   }

   gende_spec (typ);

   l_declarator (list, typ);

   return true;
} /* decl */

					    /*-------------------------*/
#ifdef LINT_ARGS
local void struct_decl ( binptr list )
#else
local void struct_decl(list)                /*  s t r u c t _ d e c l  */
binptr list;
/*
 *  declaration
*/
#endif
{
   binptr typ;

   if (list == NIL)   return; /* nothing to do */

   for (typ=list;                    /* Get type from end of list. */
	binsymc (typ=binright (typ)) == cCsymbol or
	binsymc (typ) == cIdlist;);

   gende_spec (typ);

   l_declarator (list, typ);

} /* struct_decl */

#ifdef LINT_ARGS
local void  l_struct_decl  ( binptr list)
#else
local void  l_struct_decl (list)
binptr list;
#endif
{
    if  (list == NIL)   return ;
    while ( binsymc (list) == cSemicolon ) {
       struct_decl (binleft (list));
       mergtill (list);
       gen (";"); genline ();
       list=binright(list);
    }
    struct_decl (list);
    gen (";"); genline ();
}


					     /*-------------------------*/
#ifdef LINT_ARGS
local void gentagfield  (  binptr typ)
#else
local void gentagfield (typ)                 /*  g e n t a g f i e l d  */
/*
    Generates tag-field of a record (struct/union).
    'typ' must be a cRECORD-node.
*/
binptr typ;
#endif
{
   binptr list;

   l_struct_decl (binleft(typ));                  /* Static part */
   if (binsymc(list=binright(typ))==cCASE) {
      gen ("union {");
      inctabs (); genline ();

      if ( binright(list) != NIL ) do {           /* Scan list of variant */
	   binptr colon;                          /* parts.               */

	   list=binright(list);
	   if ( binsymc(list) == cSemicolon ) colon=binleft(list);
	   else colon=list;

	   gen ("struct {");
	   inctabs (); genline ();
	   if ( binsymc (binright(colon)) == cRECORD )
	      gentagfield (binright(colon));       /* Nested 'case'. */
	   else
	      l_struct_decl (binright(colon));
	   dectabs ();
	   gen ("} "); gen (symtab(binsym(binleft(colon))));
	   gen (";"); genline ();
      } while ( binsymc(list)==cSemicolon );

      dectabs ();
      gen ("} "); gen (symtab(binsym(binleft(binright(typ)))));
      gen (";"); genline ();
   }
} /* gentagfield */


						      /*-----------------*/
#ifdef LINT_ARGS
global void genstm ( binptr p)
#else
global void genstm(p)                                 /*   g e n s t m   */
binptr p;
#endif
BEGIN (genstm)
  binptr list;
  int klammer = 0;
  symctype symc;

#ifdef Error_Seek
printf ("genstm: %s\n", symptext[binsymc(p)]);
#endif

    if (p==NIL) { gen(";"); genline(); return; }

    geneline (p,cSemicolon,false);

    switch ( binsymc (p) ) {

      case cSemicolon :
	do {  /* repeat */
	  genstm (binleft(p));
	  mergtill (p);
	  p = binright(p);
	} while (binsymc(p) == cSemicolon);

	mergtill (p);
	genstm (p);
      break;

      case cColon :      /* Marke, Label */
	genexpr (binleft(p));
	mergtill (p);
	gen (" : ");
	genline ();
	genstm (binright(p));
      break;

      case cAssign :
       if ( binsymc (binleft (p))!=cTYPE ) {
	 genexpr (binleft(p));
	 mergtill (p);
	 gen (" = ");
	 genexpr (binright(p));
	 gen (";");
	 genline ();
       } else {

	 list =binleft (p);
	 symc=binsymc (unname (binleft  (list)));
	 if ( symc==cARRAY or symc==cDYNAMIC or symc==cRECORD )
	    genvarloc (binright(list),binleft  (list),ASGNFREE);

	 if ( symc==cARRAY ) {
	    unsigned long size = 1 ; /* product of index ranges */
	    binptr eltyp;

	    mergtill (p);
	    gen ("memcpy(");
	    genexpr (binright(list));
	    gen (",");
	    genexpr (binright(p));
	    gen (",(a_intg)");

	    list=unname (binleft  (list));

	    while  (binsymc (list) == cARRAY) {    /* evaluate array size */
	      size *= rangesize (unname (binleft (list))) ;
	      list = unname (eltyp= binright (list)) ;
	    }

	    genint ((long) size);
	    gen ("*sizeof(");
	    (void) gentyp (eltyp);
	    gen ("))");
	 } else
	   if ( symc==cDYNAMIC ) {
	    mergtill (p);
	    gen ("y_asgn((y_dscp)(a_VOID) &(");
	    genexpr (binright(list));
	    gen ("),(y_dscp)(a_VOID) &(");
	    genexpr (binright(p));
	    gen ("))");
	 } else {
	    genexpr (binright(list));
	    mergtill (p);
	    gen (" = ");
	    genexpr (binright(p));
	 }
	 gen (";");
	 genline ();
	 if ( symc==cARRAY or symc==cDYNAMIC or symc==cRECORD )
	    genvarloc (binright (binleft(p)),binleft (binleft(p)),ASGNCOPY);
       }
      break;

      case cWITH :
	gen ("/*  with ...  ");
	gen ("*/");
	genexpr (binleft(p));
	genline ();
	inctabs ();
	genstm (binright(p));
	dectabs ();
	genline ();
	genline ();
      break;

      case cWHILE :
	mergtill (p);
	gen ("while ( ");
	if ( binsymc (binleft(p))==cSemicolon )
	   gen ("1 ");
	else
	   genexpr (binleft(p));
	gen (") ");

	if ( binsymc (binright (p)) == cSemicolon or
	     binsymc (binleft (p)) == cSemicolon  or
	     on_number ) {
	   gen ("{");
	   inctabs ();
	   genline ();
	   if ( binsymc (binleft(p))==cSemicolon )
	    begin
	      list = binleft (p) ;
	      while  (binsymc(list) == cSemicolon) {
		genstm (binleft (list));
		list = binright(list) ;
	      }
	      gen ("if ( !( ");
	      genexpr (list);
	      gen (" )) break;");
	      genline ();
	    end
	   genstm (binright (p));
	   geneline (p,cSemicolon,true);
	   dectabs ();
	   gen ("}");
	}
	else {
	   genline ();
	   inctabs ();
	   genstm (binright (p));
	   dectabs ();
	}
	genline ();
      break;

      case cREPEAT :
	gen ("do ");
	mergtill (p);

	if (binsymc(binleft (p)) == cSemicolon
	    or on_number ) {
	  gen ("{");
	  inctabs ();
	  genline ();
	 /* geneline (p,cSemicolon,true); */
	 /* geneline (binright(p),cSemicolon,true); */
	  genstm (binleft (p));
	  dectabs ();
	  gen ("}");
	}
	else {
	  genline ();
	  inctabs ();
	  genstm ( binleft (p));
	  dectabs ();
	}

	gen (" while (!(");
	genexpr (binright(p));
	gen ("));");
	genline ();
      break;

      case cFOR :
	if  (on_fastfor)  begin
		gen ("for (");
		genexpr (binleft(p));
		mergtill (p);
		gen (";");
		genexpr (binleft(binleft(p)));
		if (binsymc(binright(p)) == cDOWNTO)
		    gen (">=");
		else gen ("<=");
		genexpr (binleft(binright(p)));
		gen (";");
		genexpr (binleft(binleft(p)));
		if (binsymc(binright(p)) == cDOWNTO)
		    gen ("--)");
		else gen ("++)");
		genanw (binright(binright(p)));
	end  else  begin   /* standard conform for-loop */
		mergtill (p);
		gen ("if ( (");
		genexpr (binleft(p));
		gen (")");
		if (binsymc(binright(p)) == cDOWNTO)
		    gen (">=");
		else gen ("<=");
		genexpr (binleft(binright(p)));
		gen (" )"); genline ();
		gen ("for (;;");
		genexpr (binleft(binleft(p)));
		if (binsymc(binright(p)) == cDOWNTO)
		    gen ("--)");
		else gen ("++)");
		gen ("{");
		inctabs ();
		genline ();
		genstm (binright(binright(p)));
		geneline (p,cSemicolon,true);
		gen ("if ( ");
		genexpr (binleft(binleft(p)));
		if (binsymc(binright(p)) == cDOWNTO)
		    gen ("<=");
		else gen (">=");
		genexpr (binleft(binright(p)));
		gen (" ) break;");

		dectabs ();
		genline ();
		gen ("}");
	end  /* if  fastfor */
	genline ();
      break;

      case cIF :
	if  (binsymc (binright  (p)) != cELSE  and
	     binsymc (binfather (p)) == cELSE  and
	     binleft (binfather (p)) == p )
	  begin                 /* ELSE-less IF left hand side of ELSE */
	    klammer = true ;
	    gen ("{") ;
	    inctabs (); genline () ;
	  end

	gen ("if (");
	genexpr (binleft(p));
	gen (") ");
	mergtill (p);
	if (binsymc(binright(p)) == cELSE) {
	  genanw (binleft(binright(p)));

	  mergtill (binright(p));
	  genline ();
	  gen ("else ");
	  genanw (binright(binright(p)));
	  genline ();
	}
	else {
	  genanw (binright(p));
	  genline ();
	}
	if (klammer) dectabs (), gen ("}");
      break;

      case cCASE :
	gen ("switch (");
	mergtill (p);
	genexpr (binleft(p));
	gen (") {");
	inctabs ();
	genline ();
	list = binright(p);
	while (binsymc(list) == cSemicolon) {
	  gencase (binleft(list));
	  list = binright(list);
	}
	if (binsymc(list) == cELSE) {
	    gen ("default :");
	    genline ();
	    inctabs ();
	    genstm (binright (list));
	    dectabs ();
	    gen ("break;");
	    genline ();
	}
	else gencase (list);

	dectabs ();
	gen ("}");
	genline ();
      break;

      case cGOTO :
	gen ("goto ");
	mergtill (p);
	genexpr (binright(p));
	gen (";");
	genline ();
      break;

      case cCall :
 /*uli     case cRout :  */
	genexpr (p);
	gen (";");
	genline ();
      break;

      case cNew : {
	binptr typ=binright (unname (binleft (p)));
	boolean dyn = id_is (binid (typ),hasdyn) or
		     /* id_is (binid (typ),imported) or */
        binsymc (unname (typ))==cDYNAMIC or /*22.10.92*/
	      binsymc (unname (typ))==cSTRING or
	      binsymc (unname (typ))==cDOTPRECISION;

	if ( dyn  ) {
	   genCid (binleft (charptr1));
	   gen ("=(a_VOID) (");
	}
	genexpr (list=binright(p));
	mergtill (p);
	gen ("= (");
     /*   if (sym_is [binsymc(iddatyp (binid (list)))].identifier)*/
	(void) gentyp (binleft (p));

	gen (") malloc (sizeof(");
	(void) gentyp (typ);
	if ( dyn ) gen (")");
	gen ("));"); genline ();
	if ( dyn )
	   genvarloc (charptr1,binright (unname (binleft (p))),NEWINIT);
      } break;

      case cDispose : {
	binptr typ=binright (unname (binleft (p)));
	boolean dyn = id_is (binid (typ),hasdyn) or
		     /* id_is (binid (typ),imported) or */
	      binsymc (unname (typ))==cSTRING or
	      binsymc (unname (typ))==cDOTPRECISION;

	if ( dyn ) {
       /*    genCid (binleft (charptr1));
	   gen ("=(a_VOID) ");
	   genexpr (binright(p));
	   gen (";"); genline (); */
	   genvarloc (charptr1,typ,DISPFREE);
	}
	mergtill (p);
	gen ("free ((a_VOID) ");

	if ( dyn )
	   genCid (binleft (charptr1));
	else
	   genexpr (binright(p));

	gen (");"); genline ();
      } break;

      case cUntemp :
	genCid (binleft (charptr1));
	mergtill (p);
	gen ("=(a_VOID) &");
	genexpr (binright(p));
	gen (";"); genline ();
	genvarloc (charptr1, binleft (p), VARUNTEMP);
      break;

      case cFree :
	genCid (binleft (charptr1));
	mergtill (p);
	gen ("=(a_VOID) &");
	genexpr (binright(p));
	gen (";"); genline ();
	genvarloc (charptr1, binleft (p), VARFREE);
      break;


      default :
	if (sym_is [binsymc(p)].identifier) {
       /*uli*/
	  genexpr (p) ;
	  gen (";");
	  genline ();
       /*   genCid (p);
	  gen ("(");                   /* Procedur- bzw Functionsaufruf */
       /*   genexpr (binright(p));
	  gen (");");
	  genline ();
       uli*/
	}
	else if (binsymc(p) != cNosym) {
	  gen ("/* genstm default : ");
	  gen (symptext[binsymc(p)]);
	  gen (" */"); genline ();
	}
      break;

  }

END   /* genstm */                                  /*   g e n s t m   */
						    /*-----------------*/


						    /*-----------------*/
#ifdef LINT_ARGS
local void genanw  ( binptr p)
#else
local void genanw (p)                               /*   g e n a n w   */
binptr p;
#endif
BEGIN (genanw)

    gen ("{");
    inctabs ();
    genline ();
    genstm (p);
    dectabs ();
    gen ("}");

END   /* genanw */                                  /*   g e n a n w   */
						    /*-----------------*/


						    /*---------------------*/
#ifdef LINT_ARGS
local void genelcase  ( binptr p)
#else
local void genelcase (p)                            /*  g e n e l c a s e  */
   binptr p;
#endif
BEGIN (genelcase)
  int i,j;

  if (binsymc(p) == cTill) {
    for (i=(int) binvalue(binleft(p)), j=0;
	 i<=(int) binvalue(binright(p)); i++ )
    {  j=(j+1)%6;
       gen ("case ");
       genint ((long) i); gen (" :");
       if ( !j ) genline ();
    }
  } else {
    gen ("case ");
    genint ((long) binvalue (p));
    gen (" :");
  }
END   /* genelcase */                               /*  g e n e l c a s e  */
						    /*---------------------*/


						    /*-----------------*/
#ifdef LINT_ARGS
local void gencase  ( binptr p)
#else
local void gencase (p)                              /*  g e n c a s e  */
  binptr p;
#endif
BEGIN (gencase)
  binptr list;

  mergtill(p);

  list =binleft(p);
  while (binsymc(list) == cComma) {
    genelcase (binleft(list)) ;
    list = binnext(list);
  }
  genelcase (list) ;
  genline ();

  inctabs ();
  genstm (binright(p));
  dectabs ();
  gen ("break;");
  genline ();
END   /* gencase */                                 /*  g e n c a s e  */
						    /*-----------------*/


						 /*--------------------*/
#ifdef LINT_ARGS
global void geneline ( binptr p,symctype s,boolean b)
#else
global void geneline(p, s, b)                    /*   g e n e l i n e  */
binptr p;
symctype s;
boolean b;
#endif
{
    if ( on_number and ( b or errline!=binpos(p).line ) ) {
	gen ("e_line=");
	genint ((long) (errline=binpos(p).line) );
	if ( s == cComma ) gen (", ");
	else if ( s == cSemicolon ) gen (";"), genline ();
    }
} /* geneline */

#ifdef LINT_ARGS
local void arg_expr  ( binptr p)
#else
local void arg_expr (p)
binptr p;
#endif
{
   idptr id;

       genexpr(p);   /* Argument der Routine */
       if ( not sym_is[binsymc(p)].identifier  or  binsymc(p) == cRout  or
	    binright(p)!=NULL ) return;

       id=binid (p);
       if ( idgetkind(id)==IDPROCEDURE or
	    idgetkind(id)==IDFUNCTION ) {
	  gen (",");
	  if ( id_is (id,formpara) ) {
	     p = binfather (idbin (id));
	     if ( binsymc (p)==cColon ) p = binfather (p);
	     genCid (binright (p));
	  } else if ( id_is (id,parused) and idlevel(id) > IDMAINLEVEL) {
	     gen (symtab (disp_name[disp_index[idlevel(id)]]));
	  } else {
	     gen ("NULL");
	  }
       }
} /* arg_expr */

#ifdef LINT_ARGS
local void arg_expr_list  ( binptr p)
#else
local void arg_expr_list (p)
binptr p;
#endif
{
   binptr list;

   gen ("(");
   list = binright (p);   /* argument list. */
   if ( list ) {
      while ( binsymc(list)==cComma ) {
	  arg_expr (binleft (list));   /* Argumente der Routine     */
	  mergtill (list);
	  gen (",");
	  list = binright (list);
      }
      arg_expr (list);
   }

   gen (")");
} /* arg_expr_list */

						    /*-------------------*/
#ifdef LINT_ARGS
global void genexpr ( binptr p)
#else
global void genexpr(p)                              /*   g e n e x p r   */
binptr p;
#endif
BEGIN (genexpr)
int klammer = 0;
long i;

#ifdef Error_Seek
printf ("genexpr: %s\n", symptext[binsymc(p)]);
#endif

  if (p==NIL) return ;  /* nothing to do */

/*-------*/
/* liste */
/*-------*/
    if (binsymc(p)==cComma  or binsymc(p)==cSemicolon) {
      gen ("#error in genexpr#");
    }

/*----------*/
/* Operator */
/*----------*/
    else if (sym_is[binsymc(p)].Operator) {
	    if (binsymc(p) == cMMinus) {                       /* cMonop ?? */
	      if (cprio[binsymc(binfather(p))] > priorelop) {
		klammer = 1;
		gen ("(");
	      }
	    }
	    else if (sym_is[binsymc(p)].leftbin) {
						/* Operator mit 2 operanden  */
	      if (cprio[binsymc(binfather(p))] >= cprio[binsymc(p)]) {
		klammer = 1;
		gen ("(");
	      }
	      genexpr(binleft(p));
	    }

	mergtill (p);
	gen (symctext[binsymc(p)]);

	genexpr(binright(p));
	if (klammer) gen (")");
    }

    else switch(binsymc(p)) {                 /* keine Liste, kein Operator */

/*--------------------------*/
/*  conditional expression  */
/*--------------------------*/
      case cIF :
	gen ("(") ;
	genexpr (binleft (p));
	gen ("?") ;
	mergtill (p);
	genexpr (binleft (binright (p)));
	gen (":") ;
	genexpr (binright (binright (p)));
	gen (")") ;
      break;

/*--------*/
/* symbol */
/*--------*/
      case cCsymbol : case cTempvar : case cTempused : case cRegister :
	mergtill (p);
	gen (symtab(binsym(p)));            /* symbol ausgeben */
      break;

/*----------*/
/* constant */
/*----------*/
      case cIcon:  case cBcon:
	mergtill (p);
	if  (binsymc (p) == cIcon)
	   gen ("(a_intg)");
	else
	   gen ("(a_bool)");
	if ((i=binvalue(p)) >= 0)
	  genint (i);
	else {
	  gen ("(");
	  genint (i);
	  gen (")");
	}
      break;

      case cLParD:
	mergtill (p);

	if  (idrdconv)
	 begin      /* generate real constant conversion downward */
	   gen (symtab (idcsym(idrdconv))) ;
	   gen ("(") ;
	   genstring  (bincharp(binright(p)));
	   gen (")") ;
	 end
	else {
	   gen ("(a_real)");
	   gen (bincharp(binright(p)));
	}
      break;

      case cLParU:
	mergtill (p);

	if  (idruconv)
	 begin      /* generate real constant conversion upward */
	   gen (symtab (idcsym(idruconv))) ;
	   gen ("(") ;
	   genstring  (bincharp(binright(p)));
	   gen (")") ;
	 end
	else {
	   gen ("(a_real)");
	   gen (bincharp(binright(p)));
	}
      break;

      case cRcon:
	mergtill (p);
	if (*bincharp(p) == '-')
	   gen ("(") , klammer = 1 ;

	if  (idrconv)
	 begin                          /* generate real constant conversion */
	   gen (symtab (idcsym(idrconv))) ;
	   gen ("(") ;
	   genstring  (bincharp(p));
	   gen (")") ;
	 end
	else {
	   gen ("(a_real)");
	   gen (bincharp(p));
	}
	if (klammer) gen (")");
      break;

      case cCcon:
	mergtill (p);
	gen ("(a_char)");
	genchar ( (char) binvalue(p));
      break;

      case cScon:
	mergtill (p);
	gen ("(a_char*)");
	genstring  (bincharp(p));
      break;

/*------*/
/* "("  */
/*------*/
      case cLParent:
	genexpr (binleft (p)) ;
	mergtill (p);
	gen ("(");
	while (binsymc(p=binright(p))==cComma) {
	    genexpr(binleft(p));   /* Argumente der Routine     */
	    mergtill (p);
	    gen (",");
	}
	genexpr (p);
	gen (")");
      break;

/*-------------------*/
/* ")" cast Operator */
/*-------------------*/
      case cRParent:   case cPCast :
	if (cprio[binsymc(binfather(p))] >= cprio[binsymc(p)]) {
	  klammer = 1;
	  gen ("(");
	}
	gen ("(");
	(void) gentyp (binleft (p)) ;
	mergtill (p);
	gen (symctext[binsymc(p)]);
	genexpr (binright(p));
	if (klammer) gen (")");
      break;

/*-------*/
/* cArry */
/*-------*/
      case cArry:
	if (cprio[binsymc(binfather(p))] > cprio[cArry]) {
	    klammer = 1;
	    gen ("(");
	}
	mergtill (p);
	denCid (p);
	p=binright(p);
	while (binsymc(p)==cComma) {
	    gen (symctext[cLBrack]);
	    genexpr(binleft(p));
	    mergtill (p);
	    gen (symctext[cRBrack]);
	    p=binright(p);
	} ;

	gen (symctext[cLBrack]);
	genexpr(p);
	gen (symctext[cRBrack]);

	if (klammer)
	    gen  (")");
      break;

/*---------*/
/*   "["   */
/*---------*/
      case cArrVar:
      case cLBrack:
	if (cprio[binsymc(binfather(p))] > cprio[cArry]) {
	    klammer = 1;
	    gen ("(");
	}
	genexpr(binleft(p));
	mergtill (p);
	p=binright(p);

	while (binsymc(p)==cComma) {
	    gen (symctext[cLBrack]);
	    genexpr(binleft(p));
	    mergtill (p);
	    gen (symctext[cRBrack]);
	    p=binright(p);
	} ;

	gen (symctext[cLBrack]);
	genexpr(p);
	gen (symctext[cRBrack]);

	if (klammer) gen  (")");
      break;

/*---------*/
/* Pointer */
/*---------*/
      case cArrow:
	mergtill (p);
      /*  if (binsymc(binfather(p)) != cArrVar) */
	gen (symctext[cArrow]);
	genexpr (binleft(p));
	genexpr (binright(p));
      break;

/*---------*/
/*  "."    */
/*---------*/
      case cPoint:
	if  (binsymc (binleft(p)) == cArrow)   {
	  genexpr (binleft(binleft(p)));
	  genexpr (binright(binleft(p)));
	  mergtill(p);
	  gen ("->");                           /*  "->"  */
	  genexpr (binright(p));
	} else {                                /*  or  */
	  genexpr (binleft(p));
	  mergtill(p);
	  gen (".");                            /*  "."  */
	  genexpr (binright(p));
	}
      break;

      default :

/*------------*/
/* identifier */
/* rout       */
/* call       */
/*------------*/
	if ( ( sym_is[binsymc(p)].identifier and
	       binright (p) and
	       ( idgetkind(binid(p)) == IDFUNCTION or
		 idgetkind(binid(p)) == IDPROCEDURE
	       )
	     ) or
	     binsymc(p)==cCall or
	     binsymc(p)==cRout ) {

	   boolean bracket=false;

	   mergtill (p);

	   if ( sym_is[binsymc(p)].identifier and
		( id_is (binid (p),formpara) or
		  id_is (binid (p),parused)
		) ) {
	      gen ("(");
	      if ( id_is (binid (p),formpara) ) {
		 binptr f_access;
		 f_access = binfather (idbin (binid (p)));
		 if ( binsymc (f_access)==cColon )
		    f_access = binfather (f_access);
		 gen ("a_cpsh(");
		 genCid (binright (f_access));
		 gen (",");
		 if ( disp_level>0 )
		    gen (symtab (disp_name[disp_level]));
		 else gen ("NULL");
		 gen (")");
	      } else
		 gen ("a_2psh(NULL,NULL)");

	      gen (", ");
	      bracket=true;
	   }

	  genCid (p);                           /* C name ausgeben */
	  arg_expr_list (p);
	  if ( bracket ) gen (")");
	} else
	if ( sym_is[binsymc(p)].identifier )
	  denCid (p);                           /* C name ausgeben */

/* anything else */

	else {
	   if (cprio[binsymc(binfather(p))] >= cprio[binsymc(p)]) {
	     klammer = 1;
	     gen ("(");
	   }
	   genexpr (binleft(p));
	   mergtill(p);
	   gen (symctext[binsymc(p)]);
	   genexpr (binright(p));
	   if (klammer) gen (")");
	}
      break;

    } /* switch */


END   /* genexpr */                                 /*   g e n e x p r   */
						    /*-------------------*/


							/*---------------*/
#ifdef LINT_ARGS
global void genCid ( binptr bin)
#else
global void genCid(bin)                                 /* g e n C i d */
binptr bin;
#endif
{
#ifdef Error_Seek
printf ("genCid -> ");
printf (symtab(idcsym(id)));
#endif
    if (sym_is [binsymc(bin)] .symbol)
       gen (symtab(binsym(bin)));
    else
    if (binsymc(bin)==cOpptr)
       gen (symtab (opcsym (binop (bin))));
    else
       gen (symtab (idcsym (binid (bin))));

#ifdef Error_Seek
printf (" <- genCid\n");
#endif

} /* genCid */

							  /*--------------*/
#ifdef LINT_ARGS
global void denCid  ( binptr bin)
#else
global void denCid (bin)                                  /*  d e n C i d */
binptr bin;
#endif
BEGIN (denCid)
idkind kind;
idptr id;

#ifdef Error_Seek
printf ("denCid -> ");
printf (symtab(idcsym(id)));
#endif

 /*   if ( binsymc (bin) == cCsymbol ) {
       gen (symtab (binsym (bin)));
       return;
    } */

    id=binid(bin);
			     /* Use genCid() or genexpr() if 'bin'  */
    if (not id)              /* is not identifier.                  */
	errput (9623, pos, "function denCid") ;

    if ( (kind=idgetkind (id)) == IDVARPARAM and not
	 id_is(id,arraytype) ) gen ("(*");

    if (id_is(id,innerused) and not
	( kind==IDTYPE or kind==IDCONST) and not
	( kind==IDVARPARAM and
	  denestlevel==idlevel(id) ) )
    {
       gen(symtab(disp_name[disp_index[idlevel(id)]]));
       gen("->");
    }

    if (idwith(id))
    {
       if (binsymc(idwith(id))==cArrow)
       {    genexpr ( binleft(idwith(id)) );
	    genexpr ( binright(idwith(id)) );
	    gen ("->");
       } else
       {    genexpr ( idwith(id) );
	    gen (".");
       }
    }

    gen (symtab (idcsym (id)));

    if ( kind == IDVARPARAM and not id_is(id,arraytype) ) gen (")");

#ifdef Error_Seek
printf (" <- denCid\n");
#endif

END  /* denCid */                                       /*  g e n C i d  */





							/*-----------------*/
#ifdef LINT_ARGS
global void inctabs  ( void)
#else
global void inctabs ()                                  /*  i n c t a b s  */
#endif
BEGIN (inctabs)
    tabs++;
END /* inctabs  */


							/*-----------------*/
#ifdef LINT_ARGS
global void dectabs  ( void)
#else
global void dectabs ()                                  /*  d e c t a b s  */
#endif
BEGIN (dectabs)
    tabs--;
END /* dectabs  */


							  /*-----------------*/
#ifdef LINT_ARGS
global void mergfin  ( void)
#else
global void mergfin ()                                    /*  m e r g f i n  */
  /* copies the rest of the source to the code and closes the sourcefile */
#endif
BEGIN (mergfin)
 shortint ch='s' ;   /* char of mrgfile to merge */
 char     chp ;      /* previous char */
 int      retc = 0 ; /* return value of writing functions */

 if  (mrgfile)  then                /* merge source */
  begin
   while ( ch!=EOF )
    begin
      srcline++ ;
      retc = fprintf (codfile, "/*%03d\t", srcline) ;
      if  (retc < 6)  dskerror (pos, codfnam()) ;
      repeat
	chp = ch ;
	ch= getc (mrgfile) ;
	if  (ch == '/'  and  chp == '*')  then  retc = putc ('%', codfile) ;
	else
	  if (ch!='\n' and ch!=EOF)
	    retc = putc (ch, codfile) ;                 /* copy one char */
	if  (retc == EOF)  dskerror (pos, codfnam()) ;
      until ((ch=='\n') or (ch==EOF)) ;
      retc = fprintf (codfile, " */\n") ;
      if  (retc < 4)  dskerror (pos, codfnam()) ;
    end /* until EOF (mrgfile)  */      /* source merged */

   retc = fclose (mrgfile);
   if  (retc == EOF)  dskerror (pos, codfnam()) ;
   mrgfile = (FILE *)0;

  end
  if (tabs)   gen ("/* tabs not zero */") , genline () ;
END /* mergfin */


						       /*-----------------*/
#ifdef LINT_ARGS
global void mergtill  (  binptr p)
#else
global void mergtill (p)                               /* m e r g t i l l */
  /* Tells genline, that all source lines until at least line */
  /* must be merged with code. */
binptr p;
#endif
BEGIN (mergtill)
  shortint line ;
  if (p==NIL) return;
  line=binpos(p).line;
  if (line > tilline)  tilline = line ;
END /* mergtill */


static boolean macro=false;  /* If true, a '\\' is generated at EOL. */
								/*-----------*/
#ifdef LINT_ARGS
global void gen  ( char *str)
#else
global void gen (str)                                           /*   g e n   */
char *str;
#endif
BEGIN(gen)
  int slen;
  int retc = 0 ; /* return value of writing functions */
  if ( str==NULL ) return;

  slen=strlen(str);

  if ( col+slen > 78 ) {
    if (macro) {
      retc = fputc('\\',codfile);
      if  (retc == EOF)  dskerror (pos, codfnam()) ;
    }
    genline () ;
    col = 0;
  }

  if ( col==0 and *str=='#') macro=true;
  else
  if ( *str=='\n' ) {
     col = 0;
     if ( macro ) macro=false;
  }

  retc = fputs (str, codfile);
  if  (retc == EOF)  dskerror (pos, codfnam()) ;
  col += slen;

END /* gen */


						       /*-------------------*/
#ifdef LINT_ARGS
global void genstring  ( char *str)
#else
global void genstring (str)                            /* g e n s t r i n g */
char *str;
#endif
BEGIN(genstring)
  int retc = 0 ; /* return value of writing functions */

  if  (str==NULL)  {
     gen ("\"\"");
     return ;
  }
  col += strlen(str);
  if ( col > 78 ) genline ();

  retc = fputc ('\"', codfile);
  if  (retc == EOF)  dskerror (pos, codfnam()) ;
  for (; *str!='\0'; str++) {
    if ( *str=='\"' or *str=='\\' )
      retc = fputc ('\\', codfile), col++;
    retc = fputc (*str, codfile);
    if ( *str=='?' and *(str+1)=='?' )    /* "\" between "??" */
      retc = fputc ('\\', codfile), col++;
    if  (retc == EOF)  dskerror (pos, codfnam()) ;
  }
  retc = fputc ('\"', codfile);
  if  (retc == EOF)  dskerror (pos, codfnam()) ;

END /* genstring */


						   /*---------------*/
#ifdef LINT_ARGS
global void genint ( long i )
#else
global void genint(i)                              /*  g e n i n t  */
long i ;
#endif
{
  char buf[20];
  sprintf (buf,"%ld",i);
  gen (buf);
} /* genint */


							 /*-----------------*/
#ifdef LINT_ARGS
local void genchar  ( char ch)
#else
local void genchar (ch)                                  /*  g e n c h a r  */
char ch;
#endif
BEGIN (genchar)
  int retc = 0 ; /* return value of writing functions */

  retc = fputc ('\'', codfile);
  if ((ch=='\\') or (ch=='\'') or (ch=='\"'))
    retc = fputc ('\\', codfile), col++;
  retc = fputc (ch, codfile);
  retc = fputc ('\'', codfile);
  if  (retc == EOF)  dskerror (pos, codfnam()) ;
  col += 3;
END /* genchar */



							  /*-----------------*/
#ifdef LINT_ARGS
global void genline ( void)
#else
global void genline()                                     /*  g e n l i n e  */
#endif
BEGIN(genline)
  shortint ch='s' ;  /* char of mrgfile to merge */
  char     chp ;     /* previous char */
  int      retc ;    /* return value of writing functions */

  macro = false ;
  retc = fputc ('\n',codfile);
  if  (retc == EOF)  dskerror (pos, codfnam()) ;

  if  (mrgfile)  then                     /* merge source */
   begin
    while (srcline < tilline and ch!=EOF)
      begin
      srcline++ ;
      retc = fprintf (codfile, "/*%03d\t", srcline) ;
      if  (retc < 6)  dskerror (pos, codfnam()) ;
      repeat
	chp = ch ;
	ch= getc (mrgfile) ;
	if  (ch == '/'  and  chp == '*')  then  retc = putc ('%', codfile) ;
	else
	  if (ch!='\n' and ch!=EOF)
	     retc = putc (ch, codfile) ;                /* copy one char */
	if  (retc == EOF)  dskerror (pos, codfnam()) ;
      until ((ch=='\n') or (ch==EOF)) ;
      retc = fprintf (codfile, " */\n") ;
      if  (retc < 4)  dskerror (pos, codfnam()) ;
      end /* until tilline merged */
   end    /* source merged */

  for (col = 0; col<2*tabs and retc != EOF; col++)
    retc = fputc (' ',codfile);
  if  (retc == EOF)  dskerror (pos, codfnam()) ;
END /* genline */


						    /*---------------------*/
#ifdef LINT_ARGS
local longint getintval  ( binptr p)
#else
local longint getintval (p)                         /*  g e t i n t v a l  */
binptr p;
#endif
BEGIN (getintval)       /*  returns the integral value of subrange-limits  */
longint i;

    switch (binsymc(p)) {

      case cMMinus :
	i = (-(getintval(binright(p))));
      break;

      case cMPlus :
	i = (getintval(binright(p)));
      break;

      case cCcon :  case cIcon :  case cBcon :
	i = binvalue(p);
      break;

      case cIdent :
	i = (getintval(unname(p)));
      break;

      default :
	if (sym_is [binsymc(p)].identifier)
	  i = (binvalue(unname(p)));
	else {
		printf ("getintval default : %s\n", symptext[binsymc(p)]);
		printf ("father : %s\n", symptext[binsymc(binfather(p))]);
		i = (binvalue(unname(p)));
	 }
      break;
    }  /* switch */

  return (i);

END   /* getintval  */                              /*  g e t i n t v a l  */
						    /*---------------------*/


						    /*---------------------*/
#ifdef LINT_ARGS
global void genrange  ( binptr p)
#else
global void genrange (p)                            /*   g e n r a n g e   */
binptr p;
#endif
BEGIN (genrange)
  long i;
  long i1,i2;
  binptr elid;

  p = unname (p);

  switch (binsymc(p)) {

    case cTill :
      i1 = getintval (binleft (p));
      i2 = getintval (binright(p));
      genint (i2 - i1 + 1);
    break;

    case cLParent :
	i = 0;
	elid = p;
	while (binsymc(binright(elid)) == cIdlist) {
	    i++;
	    elid = binright(elid);
	}
	genint (i);
    break;

    case cCHAR :
	genint (256L);
    break;

    case cBOOLEAN :
	genint (2L);
    break;

    case cIdent :
	genrange(p);
    break;
    default :
	if (not p) break;
	gen (" #");
	gen (symptext[binsymc(p)]);
	gen ("# ");

  }

END  /* genrange */                                 /*   g e n r a n g e   */
						    /*---------------------*/
