/*
 *  MODULE:  syntax.c
 *  expression parser
{*  last modification:  18.02.92  13:31   }

 *  uli 19.12.90 : calls of prevOperator added
 *  uli 04.01.91 : prototypes added
 *  uli 10.01.91 : chkc and chkid are boolean functions now
 *  uli 22.02.91 : new style headers
 *  uli 27.02.91 : errecy.h must not be exported!
 *  uli 21.03.91 : check Operator in front of "[", if not variable
 *  uli 21.03.91 : parsloc[SYNTAX] changed to stoppars(SYNTAX)
 *  uli 21.03.91 : "(<" and "(>" added. #-constants deleted.
 *  uli 06.05.91 : bad_id replaced by idBAD_ID .
 *  uli 06.05.91 : error 1208 not reported twice.
 *  uli 26.09.91 : "[" : not a further index, if binprev == root.
 *  tim 11.12.91 : chkid : returns true if recovered symbolcode is in
                   identifier set. Previously only 'cIdent' was allowed.
 *  uli 18.02.92 : matchparent : Comma gracefully deleted.
*/

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

#include "option.h"
#include "error.h"
#include "scan.h"
#include "symtab.h"
#include "idtab.h"
#include "optab.h"
#include "bintab.h"
#include "blktab.h"
#include "std.h"                /* import chkskalar for loop var */
#include "errecy.h"
#include           "expor.t"
#include "syntax.h"
#include           "implemen.t"

#define CHECK

#ifdef LINT_ARGS
local boolean  eqorfath      (binptr, symctype);
local boolean  prevOperator  (binptr root);
local symctype matchparent   (binptr root);
local void     forexpression (binptr root);
#else
local boolean  eqorfath      ();
local boolean  prevOperator  ();
local symctype matchparent   ();
local void     forexpression ();
#endif
                                /*<-6.9.89*/

#if (defined(CHECK) && defined(LINT_ARGS))

local void upcheck(void);
#endif
                                /*<-6.9.89*/


#ifdef LINT_ARGS
local boolean eqorfath  (register binptr pt, register symctype symc )
#else
local boolean eqorfath (pt, symc)
  /* checks, whether pt is a symc node or a comma node at a symc node */
  register  binptr pt ;
  register symctype symc ;
#endif
BEGIN(eqorfath)
  while  ( binsymc (pt) == cComma )  pt = binfather (pt) ;
  RETURN ( binsymc (pt) == symc ) ;
END /* eqorfath */


#ifdef CHECK
#ifdef LINT_ARGS
local void upcheck  ( void)
#else
local void upcheck ()
  /* checks whether the binprev node is a right son and reports a warning */
#endif
BEGIN(upcheck)

  if  (binprev != binright (binfather (binprev)))  then
   begin
    errput (9021, binpos(binprev), (char*)0  ) ;
   /* print ("Searching upwards: Not a right son.") ;
    printline () ; */
   end
END /* upcheck */
#endif

                                                /*-------------------------*/
#ifdef LINT_ARGS
local symctype matchparent (binptr root )       /*  m a t c h p a r e n t  */
#else
local symctype matchparent (root)
  /* checks, whether last expression is complete and */
  /* searches upwards for the matching "(" or "[" */
  /* side effect on binprev ! */
   binptr root ;   /* used as stopper */
#endif
BEGIN(matchparent)
   symctype prevsymc ;

   if  (binsymc (binprev) == cComma and not binright(binprev))
      bindelete (binprev) ; /* 18.02.92 */

   if (sym_is [binsymc (binprev)].Operator and not binright(binprev))  then
     begin
      errput (1201, pos, (char*)0 ) ;
        /* print ("Operand expected.") ;
              printline () ; */
     end ;

   prevsymc= binsymc(binprev) ;
   while ( binprev!=root and prevsymc != cLBrack
                         and prevsymc != cLParent)
     begin
       if  (binprev == root)  break ;
       prevsymc= binsymc(binprev) ;
       if  (prevsymc == cLBrack or prevsymc == cLParent)  break ;
#ifdef CHECK
       upcheck () ;
#endif
       gofather () ;
       prevsymc= binsymc(binprev) ;
     end ;
   RETURN (prevsymc) ;
END /* matchparent */

                                                /*****************************/
#ifdef LINT_ARGS
local boolean prevOperator  (  binptr root )
#else
local boolean prevOperator (root)               /*  p r e v o p e r a t o r  */
  /* returns true, if an operand is allowed */
  /* reports an error, if not.              */
  binptr root ; /* syntax check ignores root */
#endif
BEGIN(prevOperator)
   symctype prevsymc = binsymc (binprev) ;
   if  (binright (binprev) or prevsymc == cArrow or
        binprev != root and sym_is [prevsymc].operand)  then
     begin
       errput (1202, pos, (char*)0 ) ;
     /*  print ("Dyadic Operator expected.") ;
       printline () ; */
       ery_loahd( cEQ);
       return (false) ;
     end
   else
       return (true) ;
END /* prevOperator */

                                        /*-----------------------------*/
#ifdef LINT_ARGS
local void forexpression  ( binptr root )
#else
local void forexpression (root)         /*  f o r e x p r e s s i o n  */
  binptr root ; /* syntax check ignores root */
#endif
BEGIN(forexpression)
  idptr    idp ;

  if  (prevOperator (root) )  then
    begin
      binsuffix () ;                                    /* SUM keyword */
      /* binchange (binprev, cSUM) ; */
      binget () ;
      if ( chkid () ) {
         idp = idfnd (sym) ;
         if  (not  idp )  then
          begin
            errput (1217, pos, (char*)0  ) ;
          /*  print ("Loop variable not declared.") ;
            printline () ; */
            idp = idins (sym, IDVAR) ;
            idsetdatyp (idp, integertype) ;
          end

         chkscalar (iddatyp (idp), pos) ;
         binupid (bincurr, idp) ;
         binsuffix () ;                                 /* loop variable */
         binget () ;
      }
      if (chkc (cAssign) ) {
         bininfix () ;                                     /* ":=" */
         binget () ;
         setparsloc(SYNTAX, cAssign);
         syntax () ;                                 /* start expression */
         pop_parsloc();
         gofather () ;
         binprefix () ;                                    /* shift left */
      }
      symkeyword (cSUM, true) ;
      if  (symc == cDOWNTO  or  chkc (cTO) )  {
         binsuffix () ;                              /* "TO" or "DOWNTO" */
         binget () ;
         setparsloc(SYNTAX, cTO);
         syntax () ;                                    /* end expression */
         pop_parsloc();
      }
      if ( chkc (cSUM) )
         symkeyword (cSUM, false) ;
         binget () ;
         binprefix () ;                                    /* shift left */
      if  (symc == cLParent) then
          binget () ;                                   /* skip "(" */
      else
        begin
          errput (1211, pos, (char*)0  ) ;
        /*  print ("'(' inserted.") ;
          printline () ; */
        end ;

      setparsloc(SYNTAX, cSUM);
      syntax () ;                                       /* recursiv call */
      pop_parsloc();

      gofather () ;
      chkc (cRParent) ;
    end
END /* forexpression */                 /*  f o r e x p r e s s i o n  */
                                        /*-----------------------------*/


                                                        /*---------------*/
#ifdef LINT_ARGS
global void syntax  ( void)
#else
global void syntax ()                                   /*  s y n t a x  */
  /* builds up an expression tree appended at binprev */
#endif
BEGIN(syntax)
  /* int      i ; */
  /* boolean  fl ; /* local flag */
  register binptr root ;
  register boolean  stop = false ;
  register symctype prevsymc ; /* symbol code of binprev */
  register binptr   son ;      /* any left or right son */
  register idptr    idp ;      /* any identifier pointer */
  register boolean minus = false ;                     /* neaga */

  root = binprev ;
#ifdef CHECK
  if (chkappend ("syntax"))  return ;
#endif

 do /* until end of expression */                       /* start parsing */
  begin         /* built up expression tree */
   prevsymc = binsymc(binprev) ;

   /*--------------*/
   /*  "+" or "-"  */           /* dyadic or monadic ? */
   /*--------------*/
   if (symc == cPlus  or  symc == cMinus) then          /*  "+" or "-"  */
     if ((sym_is [prevsymc].Operator  or
          binprev==root  or  prevsymc==cLParent  or
          prevsymc==cLBrack  or prevsymc==cArrVar  or
          prevsymc==cComma  or  prevsymc==cTill)
         and  not binright(binprev))
      begin
       if (symc==cPlus) symc = cMPlus ;                 /* change + or - */
                else    symc = cMMinus ;                /* to monadic op */
       binchange (bincurr, symc) ;
      end
     else ;
   else
   /*-------*/
   /*  "*"  */       /* multiplication or indexrange ? */
   /*-------*/
   if (symc ==  cMult) then                             /*  "*"  */
     if ((eqorfath (binprev, cLBrack) or eqorfath (binprev, cArrVar))
         and  not binright(binprev))  then
      begin
        symc = cIrange ;                                /* change "*"  */
        binchange (bincurr, symc) ;
      end ;


  switch (symc)
   begin
    /*-------*/
    /*  "."  */
    /*-------*/
    case  cPoint :                                      /*  "."  */
      if (not sym_is [prevsymc].variable) then          /* left variable */
       begin
         errput (1203, pos, (char*)0  ) ;
       /*  print ("Illegal symbol, left side is not a variable.") ;
         printline () ; */
       end ;
      if (binprev!= root) then
        bininfix() ;                                    /* "." */

      binget() ;
      if  (not sym_is [symc].identifier) then           /* right ident */
       begin
         errput (1204, pos, (char*)0  ) ;
       /*  print ("Identifier expected.") ;
         printline () ; */
         ery_loahd( cIdent);
         binappend (binprev, binidcreate (cIdent, idBAD_ID)) ;
       end
      else
       begin
        binchange (bincurr, cCsymbol) ;
        binupsym  (bincurr, sym) ;
        binsuffix() ;                                   /* ".id" */
        gofather () ;
       end
    break ;    /* "." found */

    /*-------*/
    /*  "@"  */
    /*-------*/
    case  cArrow :                                      /* "^" found */
      if  (sym_is [prevsymc].variable)  then
        bininfix () ;
      else
        begin
         errput (1205, pos, (char*)0 ) ;
       /*  print ("Left side is not a variable.") ;
         printline () ; */
        end
    break ;    /* "^" found */

    /*-------*/
    /*  "["  */
    /*-------*/
    case  cLBrack :                                     /* "[" found */
      if (prevsymc == cArrow or prevsymc == cPArrow
          or prevsymc == cPoint)  then                  /* "^" or "." */
        bininfix () ;                                   /*  precedes */
      else
      if ((prevsymc == cArry or prevsymc == cArrVar) and binprev != root)  then
      begin                                             /* further index */
        goright () ;
        while (binsymc(binprev) == cComma)              /* search end of */
           goright () ;                                 /*  index list */
        binchange (bincurr, cComma) ;
        bininfix () ;                                   /* insert "," */
        bincurr = bincreate (cLBrack) ;
        binsuffix () ;                                  /* append "[" */
      end
      else
      begin
        if (sym_is [prevsymc].identifier )  then
          if  (binright (binprev))  then
            bininfix() ;                                 /* insert "[" */
             /*  error should be reported by seman!  */
          else
           begin
             binchange (binprev, cArry) ;               /* change to arry */
             binsuffix() ;                              /* append "[" */
           end
        else
          if  (binright (binprev))  then
           begin
            errput (1202, pos, (char*)0  ) ;
                               /*  print ("Dyadic Operator expected.") ; */
           ery_loahd( cPlus);
           end
          else
           if  (prevOperator (root) )  then
             binsuffix() ;                              /* append "[" */
      end
    break ;   /* "[" found */

    /*-------*/
    /*  "]"  */
    /*-------*/
    case  cRBrack :                                     /* "]" found */
       prevsymc = matchparent (root) ;

       if (binprev == root) then
         stop = true ;                  /* not part of current expression */
       else
       if (prevsymc == cLBrack) then
         if  (binleft(binprev))  then                   /* left exists */
          begin
            if  (not binright(binprev))  then
             begin
               errput (1206, pos, (char*)0  ) ;         /* index missing */
             /*  print ("Index missing.") ;
               printline () ; */
             end ;
            binchange (binprev, cArrVar) ;              /* change priority */
          end
         else
         if  (eqorfath (binfather(binprev), cArry) or
              eqorfath (binfather(binprev), cArrVar) ) then
           begin                                        /* array access */
             if  (not binright(binprev))  then
              begin
                errput (1206, pos, (char*)0  ) ;         /* index missing */
              /*  print ("Index missing.") ;
                printline () ; */
              end ;
             (void) bindelete (binprev) ;               /* kill "[" */
             while (binsymc (binprev) == cComma)
               gofather () ;
           end
         else
           binchange (binprev, cRBrack) ;               /* change to "]" */
                                                        /* set constructor */
       else
       if (prevsymc == cLParent) then
         begin
           errput (1207, pos, (char*)0  ) ;
         /*  print ("')' expected.") ;
           printline () ; */
           ery_loahd( cRParent);
         end ;
    break ; /* "]" found */

    /*-------*/
    /*  "("  */
    /*-------*/
    case  cLParent :                                    /* "(" found */
      if  (binright (binprev))  then
        begin                                           /* cannot append */
          errput (1202, pos, (char*)0  ) ;
        /*  print ("Dyadic Operator expected.") ;
          printline () ; */
          ery_loahd( cPlus);
        end
      else
      if  (binprev == root)  then
          binsuffix() ;                                 /* append "(" */
      else
      if  (sym_is [prevsymc].identifier)  then
        begin
          if  (prevsymc == cIdent)  then
            binchange (binprev, cRout) ;                /* change to call */
          binsuffix() ;                                 /* append "(" */
        end
      else
      if  (sym_is [prevsymc].operand)  then
        begin                                           /* "(" follows operand */
          errput (1202, pos, (char*)0  ) ;
        /*  print ("Dyadic Operator expected.") ;
          printline () ; */
          ery_loahd( cPlus);
        end
      else
          binsuffix() ;                                 /* append "(" */
    break ; /* "(" found */

    /*-------*/
    /*  ")"  */
    /*-------*/
    case  cRParent :                                    /* ")" found */
       if (not(sym_is [prevsymc].operand or
               sym_is [prevsymc].variable or binright(binprev)))  then
          errput (1208, pos, (char*)0  ) ;   /*  "Expression missing."  */

       prevsymc = matchparent (root) ;

       if (binprev == root) then
         stop = true ;              /* not part of current expression */
       else
       if (prevsymc == cLParent) then                   /* matching "(" found */
         begin
           son = binright (binprev) ;
           /* if (not son)        This error must have been reported above !! */
             /*  errput (1208, pos, (char*)0  ) ; */
             /*  Expression missing.  */

           (void) bindelete (binprev) ;                        /* kill "(" */
                      /* now binprev is the father of "(" */
           if ( son and binsymc (binprev) != cCall  and
                        not sym_is [binsymc (binprev)] .identifier and
                /*      binsymc (binprev) != cComma and */
                ( binsymc (son) == cComma or
                  binsymc (son) == cTill    )) then
             begin                            /* "," or ".." in expression */
               errput (1209, binpos(son), (char*)0  ) ;
             /*  print ("Dyadic Operator or ')' expected.") ;
               printline () ; */
             end ;
         end    /* matching "(" found */
       else
       if (prevsymc == cLBrack) then                    /* matching is "[" */
         begin
           errput (1210, pos, (char*)0  ) ;
         /*  print ("']' expected.") ;
           printline () ; */
           ery_loahd( cRBrack);
         end
    break ; /* ")" found */

    /*----------------*/
    /*  "(<" or "(>"  */
    /*----------------*/
    case  cLParD: ; case cLParU : ;                     /* real const found */
      if  (prevOperator (root) )  then
        begin
          binsuffix() ;                                 /* append (< */
          binget () ;
          if (symc == cMinus) then        /* neaga */
          begin minus = true ;
                binget () ;
          end ;
          chkc (cRcon) ;
          if (minus) then
          begin
             char *o_str = bincharp(bincurr);
             char *n_str = malloc( strlen(o_str)+2);
             if  (n_str==0)  memerror (pos) ;
             *n_str = '-';
             strcpy(n_str+1, o_str);
             free(o_str);
             binupcharp(bincurr,n_str );
          end                            /* neaga */
          binsuffix() ;                             /* append constant */
          gofather() ;
          binget () ;
          chkc (cRParent) ;
         end
       else
        begin                           /* ignore constant */
          binget () ;
          chkc (cRcon) ;
          binget () ;
          chkc (cRParent) ;
         end
    break ; /* "(<" or "(>" found */

    /*-------*/
    /*  "#"  */
    /*-------*/
    case  cDot : ; case cDotN : ;                       /* "#" found */
    case  cDotD: ; case cDotU : ; case cDotS :
      setparsloc(SYNTAX, cDot);
      if  (prevOperator (root) )  then
        begin
          binsuffix() ;                                 /* append # */
          binget () ;
          if  (symc == cLParent) then
              binget () ;                               /* skip "(" */
          else
              errput (1211, pos, (char*)0  ) ;         /* '(' inserted. */

          syntax () ;                                   /* recursiv call */

          chkc (cRParent) ;
         end
      pop_parsloc();
    break ; /* "#" found */

    /*---------*/
    /*  "for"  */
    /*---------*/
    case  cFOR :                                        /* "for" found */
         forexpression (root) ;
    break ; /* "for" found */

    /*--------*/
    /*  ".."  */
    /*--------*/
    case  cTill:                                        /* ".." found */
         if (not(binprev != root and
                 (sym_is [prevsymc].operand or sym_is [prevsymc].variable) or
                 binright(binprev)))  then
           begin
            errput (1201, pos, (char*)0  ) ;
          /*  print ("Operand expected.") ;
            printline () ; */
           end ;

         while (binprev != root and                     /* priority search */
                priotill < symprio(binsymc(binprev)) )
          begin
#ifdef CHECK
            upcheck () ;
#endif
            gofather () ;
          end ;

         if  (binprev == root)  then
           stop = true ;            /* not part of current expression */
         else
          begin
            son = binprev ;   /* son is father ! */
            while  (binsymc (son) == cComma)    /* search father of comma list */
              son = binfather (son) ;
            prevsymc = binsymc (son) ; /* miss use! */
            if  (prevsymc != cRBrack and                      /* set constr. */
                 prevsymc != cLBrack and prevsymc != cArry    /* array access */
                 and prevsymc != cArrVar
                ) then
              begin             /* only legal in index list or set constructor */
                errput (1212, pos, (char*)0  ) ;
              /*  print ("Illegal symbol.") ;
                printline () ; */
              end ;

            if  (binright (binprev))  then
              goright () ,
              bininfix () ;                            /* insert ".." */
          end /* belongs to expression */
    break ; /* ".." found */

    /*-------*/
    /*  ","  */
    /*-------*/
    case  cComma:                                       /* comma found */
         if (not(binprev != root and
                 (sym_is [prevsymc].operand or sym_is [prevsymc].variable) or
                 binright(binprev)))  then
           begin
            errput (1201, pos, (char*)0  ) ;
           /* print ("Operand expected.") ;
            printline () ; */
           end ;

         while (binprev != root and                     /* priority search */
                priocomma < symprio(binsymc(binprev)) )
          begin
#ifdef CHECK
            upcheck () ;
#endif
            gofather () ;
          end ;

         if  (binprev == root)  then
           stop = true ;            /* not part of current expression */
         else
         if  (binright (binprev))  then
           goright () ,
           bininfix () ;                                /* insert comma */
    break ; /* "," found */

    default :
    /*------------------*/
    /* operand or monop */
    /*------------------*/                              /* append */
    if  (sym_is [symc].operand   or                     /* operand */
         symprio (symc) == priomonop)  then             /* or monop */
      if  (prevOperator (root))  then
        begin
          if  (sym_is [symc].identifier)  then
           begin
             idp = idfnd (sym) ;
             if  ( idp )  then
               binupid (bincurr, idp) ; /* idtab entry exists */
             else
              if  (symc == cIdent)  then
               begin
                 idsetdatyp (idp = idins (sym, IDNONE), anytype) ;
                 binupid (bincurr, idp) ;
                 errput (1213, pos, (char*)0  ) ;
               /*  print ("Identifier not declared.") ;
                 printline () ; */
               end
              else ;  /* standard identifier, binid = NIL */
           end ;
/*NEW*/           if ( not stoppars(SYNTAX) )
              binsuffix() ;                       /* append operand */
        end
      else /* error illegal operand */ ;
    else /* not to be appended */

    /*----------*/
    /* Operator */
    /*----------*/
    if  (sym_is [symc].Operator or                      /* dyadic Operator */
         symc == cArrow )  then
      if  ( (sym_is [prevsymc].operand  or sym_is [prevsymc].variable) and
           binprev != root  or
           binright(binprev))  then   /* preceeded by operand */
        begin
         while (binprev!=root and                       /* priority search */
                symprio(symc) <= symprio(binsymc(binprev)) )
          begin
#ifdef CHECK
            upcheck () ;
#endif
            gofather () ;
          end ;

         goright () ;

         if  (sym_is [symc].userdefined)  then
           binopinfix () ;                  /* insert priodefined Operator */
         else
           bininfix () ;                                /* insert Operator */
        end /* previous is not Operator */
      else
        begin
         errput (1201, pos, (char*)0  ) ;
        /* print ("Operand expected.") ;
         printline () ; */
        end
    else    /* symbol is not part of current expression */

    /*----------------*/
    /* illegal symbol */
    /*----------------*/
     begin
      if  (sym_is [prevsymc].Operator and not binright(binprev))  then
       begin
         errput (1201, pos, (char*)0  ) ;
       /*  print ("Operand expected.") ;
         printline () ; */
         binappend (binprev, binidcreate (cIdent, idBAD_ID)) ;
         ery_loahd( cIdent);
       end
      stop = true ;
     end ;
   end /* switch symc */ ;

  if (not ( stoppars(SYNTAX) or  stop))
      binget () ;         /* scan next symbol */
  end
 while ( not ( stoppars(SYNTAX) or  stop )) ;
                                                      /* end parsing */


 while  (binprev != root)                       /* check for missing ")" "]" */
  begin
    prevsymc = matchparent (root) ;

    if  (binprev == root)  then   break ;
    if (prevsymc == cLBrack) then
      begin
        errput (1214, pos, (char*)0  ) ;
      /*  print ("']' missing.") ;
        printline () ; */
        ery_loahd( cRBrack);
      end
    else
    if (prevsymc == cLParent) then
      begin
        errput (1215, pos, (char*)0  ) ;
      /*  print ("')' missing.") ;
        printline () ; */
        ery_loahd( cRParent);
      end
    gofather () ;
  end ; /* until root reached , check for "(" and "[" */

  if (not binright (root)) then                 /* expression found ? */
    begin
      errput (1216, pos, (char*)0  ) ;
    /*  print ("Expression missing.") ;
      printline () ; */
      binappend (binprev, binidcreate (cIdent, idBAD_ID)) ;
    end ;
END /* syntax */                                /*  s y n t a x  */
                                                /*---------------*/




                /* former module pars.c */

                                                /*-----------*/
#ifdef LINT_ARGS
global boolean chkc (  symctype psymc )
#else
global boolean chkc(psymc)                         /*  c h k c  */
  /* reports an error, if the current symbol code is not psymc,
   tries to recover symc.Returns 'true', if no error occurred  */
symctype psymc ;
#endif
BEGIN(chkc)
 boolean chk ;

 if (symc != psymc && ! stop_chk() )
  begin
   errput (1298, pos, symptext[psymc]) ;
  /* print (symptext[psymc]) ; print (" expected. " ) ;
   print (symptext [symc]) ; print (" found.") ;
   printline() ; */
   symc = psymc;
   ery_loahd( symc);                 /* error recovery routine */
  end
 chk = (symc == psymc);      /* side effect of ery_loahd on symc */
                             /* determines value of 'chk' */
 return(chk);
END /*chkc*/

                                                                /*-------*/
#ifdef LINT_ARGS
global boolean id ( void)
#else
global boolean id()                                             /*  i d  */
  /* returns whether the current symbol is an identifier */
#endif
BEGIN(id)
 RETURN(sym_is[symc].identifier);
END /*id*/

                                                        /*-------------*/
#ifdef LINT_ARGS
global boolean chkid (  void)
#else
global boolean chkid()                                  /*  c h k i d  */
  /* reports an error, if the current symbol is not an identifier, */
  /* changes sym to "bad_id". */
#endif
BEGIN(chkid)
 boolean chk ;

 chk = sym_is[symc].identifier;
 if (sym_is[symc].identifier)
 begin
#ifdef TRACE
  printf("identifier %s\n",symtab(sym));
#endif
  return (chk);
 end
 else if ( ! stop_chk() )
  begin
   errput (1299, pos, (char*)0) ;
  /* print ("Identifier expected. ") ;
   print ( symtab(sym) ) ; print (" found") ;
   printline() ; */
   sym = sNosym ;
   symc= cIdent ;
   ery_loahd( cIdent);                       /* error recovery routine */
   chk = sym_is[symc].identifier;  /* side effect of ery_loahd on symc */
                                          /* determines value of 'chk' */
   return (chk);
  end
 else
   return ( false );
END /*chkid*/

#ifdef CHECK
                                                /*--------------------*/
#ifdef LINT_ARGS
global boolean chkappend  ( char * s )
#else
global boolean chkappend (s)                    /*  c h k a p p e n d */
char * s ;
  /* reports an error with additional string s and returns true, */
  /* if binprev is not a right-son node. Otherwise returns false */
#endif
BEGIN(chkappend)
  if  (not sym_is[binsymc(binprev)].rightbin)
   begin                                         /* abort, if expression */
     errput (9022, binpos(binprev), s) ;         /* cannot be appended */
     return true ;
   end ;
  return false ;
END /* chkappend */

#endif
