
	/* include statements.	*/

# include "rasl.h"
# include "cdecl.h"
# include "cfunc.h"
# include "arithm.h"

# define  RESIDUE  50

# define ESCAPE '\\'
/*# define ESCAPE '#'*/

# define IS_UTF_HEADER(byte) ( ((byte) & '\xC0') == '\xC0' )
# define IS_UTF_BODY(byte)   ( (((byte)>>6) == 2) )


extern struct bitab bi [];
extern long nbi;

/* local: */
int rc_getid1 (int);
int rc_get_idapplicant (int);
int rc_getuchar (int, int);
int rc_getid_mess (int, int);
int rc_getid_NO_mess (int);
int rc_getvarid (int);


/* return the number of the builtin function or 0 */
long rc_binumber (s)
     char *s;
{
  int i;

  for (i = 0; i < nbi; i++) 
    if (strcmp (s, bi [i].fname) == 0) return (long)(bi [i].fnumber);
  return 0L;
}

static char ascii = 1;

// The following variable takes care of function names that are similar a type-indexed variable name. // Nemytykh, 01.09.2023
static int fname_vs_vname = 1;
 

/*  function to get the next token.	*/
int
rc_gettoken (void) {
  /*   legal tokens are   :                                       */
  /*      VAR     -       variable,                               */
  /*      ID      -       identifier,                             */
  /*      VAR_type -   variable typed by a lower unicode-index   */
  /*      PREWORD -       preword,                                */
  /*      COMPSYM -       compound symbol,                        */
  /*      MDIGIT  -       macrodigit,                             */
  /*	    MSTRING -		  string not in ASCII value			      */ //Teriukha 
  /*      ASCIIV  -       symbol represented by its ASCII value,  */
  /*      LCBRAK  -       left concretization bracket,            */
  /*      STRING  -       string of printable characters.         */
  /*      EXTRN   -       ID of the form "EXTRN" or "ENTRY"       */
  /*   In addition to these there is a number of other characters */
  /*   which could be returned (list separated by blanks):        */
  /*   = ( ) > , : ; { } [ ]                                      */

	int c,d;
	/*char ch;*/
	// int prev_token;

	token = 0;
	c = (globsav == 0)? rc_gchar(): globsav;
	globsav = 0;
	while (token == 0) {
		while ( (c == ' ') || (c == '\t')) c = rc_gchar ();
		switch (c) {
		case EOF : return c;

		case '\n': 
			/* skip comment. */
			if ((c = rc_gchar ()) == '*') 
				while ((c = rc_gchar ()) != '\n')
					if (c == EOF) return EOF;
			break;

		case '/' : 
			if ((c=rc_gchar ()) != '*') {
				rc_serror (1,NULL);
			} else {
				c = rc_gchar ();
				do {
					while (c != '*') {
						if (c == EOF) {
							rc_serror (2,NULL);
							return EOF;
						}
						c = rc_gchar ();
					}
				} while ((c=rc_gchar ()) != '/');
				c = rc_gchar ();
			}
			break;

		case '.' : /* MDIGIT or COMPSYM    */
			token = rc_getsym ();
			c = ' ';
			break;

		case 'e' :
		case 's' :
		case 't' :
		/*case 'w' :*/
			d = rc_gchar ();
			if (d == '.') {
				/* variable.  */
				vtype = (char) c;
				fname_vs_vname = 0; // This flag signals on a regular variable name, i.d. the name is not a type-indexed one.
				token = rc_getind ();
			} else if (d != EOF) {
				int i;
/* Nemytykh [ .... */
                         	if (isalnum (d) || (d == '_') || (d == '-') || (d >= 128)) { //Teriukha utf8 символ считаем
                                   token = rc_getid (d);
                                   for (i = length; i > 0; i --) {
					str [i] = str [i - 1];
                        	   }
                                } else {
                                        token = rc_getid1 (c);
                                        globsav = (char) d;
                                };
/* Nemytykh .... ]  */
				str [0] = (char) c;
			} else {
				rc_serror (20, NULL);
			}
			c = ' ';
			break;

		case ESCAPE:
			c = rc_gchar ();
			if (c == 'x') {
				int i_w;
				char c_w = 0;

				for (i_w = 0; i_w < 2; i_w ++) {
					if (EOF == (c = rc_gchar ())) {
						rc_serror (7, NULL);
					}
					if (isxdigit (c)) {
                  c = tolower(c);
				   	c = (c <= '9')? c - '0': (c - 'a' + 10);
						c_w += ((i_w)? c: 16 * c);
					} else {
						rc_serror (7, NULL);
					}
				}
				v = c_w;
				token = ASCIIV;
				c = ' ';
			} else if (c == 'n' || c == 'r' || c == 't' || c == '\'' || c == '"' || ' ' ||
				c == '<' || c == '>' || c == '(' || c == ')' || c == ESCAPE) {
				if (c == 'n') v = '\n';
				else if (c == 'r') v = '\r';
				else if (c == 't') v = '\t';
				else v = c;
				token = ASCIIV;
				c = ' ';
			} else {
				rc_serror (7, NULL);
				token = 0;
			}
			
			break;

		case '\'':
		case '"':
			/* string */
			ascii = 1;
			token = rc_getstr (c);
			c = ' ';
			break;

		case '<' : /*  left concretization bracket  */
			c = rc_gchar ();
			fname_vs_vname = 1;
			token = LCBRAK;
			switch (c) {
			case '+':
				strcpy (str, bi [ADD].fname);
				break;
			case '-':
				strcpy (str, bi [SUB].fname);
				break;
			case '*':
				strcpy (str, bi [MUL].fname);
				break;
			case '/':
				strcpy (str, bi [DIV].fname);
				break;
			case '%':
				strcpy (str, bi [MOD].fname);
				break;
			case '?':
				strcpy(str, "Residue");
				break;
			case '.':
				c = rc_gchar ();
			default:
			if (isalpha (c) || c >= 128) { 
			  int tapplicant = rc_getid (c); // Nemytykh after Teriukha, 12.05.2023, 77777
 	
			  if ( tapplicant == 0 ) {
//			  	rc_serror (203, NULL);
				c = rc_gchar ();
			  }
			} else {
					/* ch = c; */
					rc_serror (4, (char *) & c);
					c = ' ';
		   }
				break;
			}
			break;
      
		case '(' :
		case ')' :
		case ',' :
		case ':' :
		case ';' :
		case '{' :
		case '}' :
		case '>' :
		case '=' :
		case '[' : /* For parametrs. Insert by Shura. 12.02.98 */
		case ']' : /* For parametrs. Insert by Shura. 12.02.98 */
			/* special symbol. */
			token = c;
			break;

		case '$' :
			token = 0;
			if (isupper (c = rc_gchar ())) {
				rc_getid (c);
				if (strcmp (str,"EXTRN") == 0)  token = EXTRN;
				else if (strcmp (str,"EXTERN") == 0) token = EXTRN;
				else if (strcmp (str,"EXTERNAL") == 0) token = EXTRN;
				else if (strcmp (str,"ENTRY") == 0) token = ENTRY;
				else { 
					c = '\n';
					rc_serror (14,NULL);
				}
			} else {
				c = '\n';
				rc_serror (14,NULL);
				token = 0;
			}
			break;

		default : /* c is an ascii-letter, unicode-character or error */
			token = ID;
			if (isalpha (c) || c >= 128) { 
			  int tapplicant = rc_getid_NO_mess (c); // Nemytykh after Teriukha, 12.05.2023, 77777
			  if ( tapplicant == ID ) { 
			    token = tapplicant;
			    int last = 0;
			    while (str[last++] != '\0');
			    last--;
			    	/* the utf-8 length of the indices is 3 */
			    if ( (fname_vs_vname == 0) && (last > 3) && (vtype = (char) isLowIndexVarType((char *)str+last)) ) { // добавил vtype
               char bchar = str[last-3];  /* the length of any low variable index is 2 tytes */ 
               str[last-3] = '\0';
 			    	if ( !isVarIdentifierIndx((char *)str) ) { /* Nemytykh, 16-08-2023 */
/* Was:
			    		rc_serror (3,NULL);
			    		str[last-3] = bchar;
			    		return (token = 0);
*/			    		
			    		str[last-3] = bchar;
			    		return token;
			    	} else {	/* variable.  */
		    		str[last-3] = bchar; // ++++++++++++
//+			    	token = VAR;
               token = VAR_type;
			    }
			    } else {
			    	fname_vs_vname = 0;
			    	token = ID;
			    }
			  }
			     /* the string str was read by rc_getid_NO_mess above */
			  else if ( isPreWord((char *)str) ) {
			  	 token = PREWORD;
			    c = ' ';
			  } else {
             rc_serror (203, NULL);
             c = rc_gchar ();
			  }
			} else if (isdigit (c)) token = rc_getnumb (c);
			else {
				rc_serror (4, (char *) & c); 
				c = rc_gchar ();
			}
			break;
		}
	}

	fname_vs_vname = 0;
	return token;
}

/* get a string  of digits or an id  terminated by a '.' and 
 * save it in the global array str [] and return MDIGIT or COMPSYM 
 */
int rc_getsym (void) {
	int  atype,i,c,warning;
	i = 1;
	warning = 0;
	c = rc_gchar ();
	if (isdigit (c)) atype = MDIGIT;
	else if (isalpha (c)) atype = COMPSYM;
	else {
		rc_serror (5,NULL);
		return 0;
	}

	if (atype == MDIGIT) str [0] = (char) c;
	else strings [0] = (char) c;

	while ( (c = rc_gchar ()) != '.') {
		if (i >= MAXWS) warning = --i;
		if (isdigit (c)) {
			if (atype == MDIGIT) str [i++] = (char) c;
			else strings [i ++] = (char) c;
		} else if ( (isalpha (c)) && (atype == COMPSYM)) {
			strings [i ++] = (char) c;
		} else {
			rc_serror (5,NULL);
			return 0;
		}
	}
	if (atype == MDIGIT) str [i] = 0;
	else strings [i] = 0;
	length = i;

	if (warning != 0) rc_swarn (1);
	return atype;
}


/* get an index of a variable terminated by any non-digit, if the index is a number, 
                                  or otherwise non-letter, and save it in str []. */
int rc_getind (void) {  /* Nemytykh, 15-08-2023, 77777 */
	int i,c,warning;

	i = 0;
	warning = 0;
	c = rc_gchar ();
	
	while( isdigit (c) ) {
		if (i >= MAXWS) warning = --i;
		str [i++] = (char) c;
	   c = rc_gchar ();
	}
	if ( i > 0 ) { 
	   globsav = (char)c; /* c == '.' ? ' ' : c;*/
	   str [i] = '\0';
	   length = i+1;
	   goto varindx; 
	}
	
// Was:	if ( ! (rc_getid_NO_mess (c)) ) {
	if ( ! rc_getvarid (c) ) {
		rc_serror (3,NULL);
		return 0;
	}
	
varindx:
	if (warning != 0) rc_swarn (2);
	return VAR;
}

/* The function rc_getuchar reads uchar in (char *) str+i.
   It returns the shifted index along the str.
*/
int rc_getuchar (int ch, int i) {
   unsigned char header;
	char stray[5] = {'\0','\0','\0','\0','\0'};
   int err = 0;
   int j = i;
  
	if ( IS_UTF_HEADER((unsigned char)ch) ) {
		header = (unsigned char)ch;
   	if ( (header & '\xF8') == '\xF8' ) err++; /* utf8_ln > 4 */
   	else {
   		str [i++] = (char)ch;
		   for ( ; ((header & '\xC0') == '\xC0'); header = header<<1 ) {
            ch = rc_gchar ();
			   str [i++] = (char)ch;
			   if ( !IS_UTF_BODY(ch) ) { err++; break; }
		   }
   	}
	}
	if (err) {
		strncat(stray,str+j,i+1);
		rc_serror(207,stray);
	}
	return i;
}			

int rc_get_idapplicant (int d) {
	int i,j,c,warning;
//	unsigned char header;
	utf usymb;

	warning = 0;

	i = 0;
	/* The first applicant symbol */
	if (d >=128) {
		i = rc_getuchar(d,0);
		if ( i < 2 ) {
			c = ' '; 
      	globsav = (char)c;
			return 0;
		}
   	usymb = r_isunicode(str);
		if ( ri_isIndex(usymb) ) { /* The first applicant symbol cannot be a unicode index. */ 
			c = ' '; 
      	globsav = (char)c;
			return 0;
		}
	}
	else { str [i++] = (char) d; }
	
	/* Applicant body consists of a prefix and a suffix. 
	  The prefix does not includes unicode indices, while the suffix includes only unicode indices and may be empty. 
	*/
	c = rc_gchar ();
	/* Applicant body prefix ++ [symbol]. */
	while (isalnum (c) || (c == '_') || (c == '-') || (c >=128)) { // Nemytykh after Teriukha
	   if (c >=128) {
	   	if ((i+4) >= MAXWS) { warning = (i -= 4); }
	   	j = i;
	   	i = rc_getuchar(c,j);
	   	if ( (i-j) < 2 ) {
	   		c = ' '; 
         	globsav = (char)c;
	   		return 0;
	   	}
	   	usymb = r_isunicode(str + j);
			if ( ri_isIndex(usymb) ) {
				c = rc_gchar ();
				break;
			}
	   } else { 
	   	if (i >= MAXWS) warning = --i;
	      str [i++] = (char) c; 
	   }
		c = rc_gchar ();
	}
	
	/* Applicant body suffix without its first symbol. */
	while ( c >=128 ) {
		if ((i+4) >= MAXWS) warning = (i -= 4);
	   j = i;
	   i = rc_getuchar(c,j);
	   if ( (i-j) < 2 ) {
	   	c = ' '; 
         globsav = (char)c;
	   	return 0;
	   }
	   usymb = r_isunicode(str + j);
		if ( !ri_isIndex(usymb) ) { 
  		   while (j<i) { rc_ungchar(str[--i]); }
		   
         i = j; 
		   c = rc_gchar ();
			break;
		}
		c = rc_gchar ();
	}
	globsav = (char)c;
	str [i] = '\0';
	length = i+1; /* ??? */
	if (warning != 0) { rc_swarn (1); return 0; }
	return 1;
}

/* get id with the first character d. */
int rc_getid_mess (int d,int mess) {

   if ( rc_get_idapplicant(d) ) { 
     if ( isIdentifier((char *)str) ) return ID;
 	  if ( mess ) rc_serror (104, (char *) str);
     return 0;
   }
	if ( mess ) rc_serror (203, NULL);
	return 0;
}

int rc_getid_NO_mess (int d) {
	return rc_getid_mess (d,0);
}

int rc_getvarid (int d) {
	
   if ( rc_get_idapplicant(d) ) { 
     if ( isVarIdentifierIndx((char *)str) ) return VAR;
     return 0;
   }
	return 0;
}

int rc_getid (int d) {
	return rc_getid_mess (d,1);
}


/* Nemytykh: get id with the only letter d. */
int rc_getid1 (int d) {
	str [0] = (char) d;
	str [1] = '\0';
	length = 2; 
	return ID;
}


/* Insert by Shura. 27.05.99 */
#define MAX_STR_ERROR 200

/* print syntax error message. */
int
rc_serror (int code, char * str) {
  char ca_err [MAX_STR_ERROR]; /* Insert by Shura. 27.05.99*/

  globsav = 0;
  if (nerrors++ > 100) {
    fprintf (fdlis,"\nToo many errors. Aborted.\n");
    /* The line is inserted by Shura. 27.05.99 */
    fprintf (stderr, "\nToo many errors. Aborted.\n");
    exit (1);
  };
  /* Was. Shura. 27.05.99
   *  fprintf (fdlis,"Error: ");
   */
  strcpy (ca_err, "Error: "); /* Insert by Shura. 27.05.99 */
  switch (code)	{
  case  1: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 1. Illegal comment ");
     */
    strcat (ca_err, " 1. Illegal comment ");
    break;
  case  2: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 2. Unexpected EOF encountered ");
     */
    strcat (ca_err, " 2. Unexpected EOF encountered ");
    break;
  case  3: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 3. Illegal index of a variable ");
     */
    strcat (ca_err, " 3. Illegal index of a variable ");
    break;
  case  4: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 4. Illegal character: %c (%d)",*str,*str);
     */
    sprintf (ca_err + strlen (ca_err), " 4. Illegal character: %c (%d)",
	     * str, * str);
    break;
  case  5: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 5. Illegal compound symbol ");
     */
    strcat (ca_err, " 5. Illegal compound symbol ");
    break;
  case  6: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 6. No closing quote ");
     */
    strcat (ca_err, " 6. No closing quote ");
    break;
  case  7: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 7. Illegal number ");
     */
    strcat (ca_err, " 7. Illegal number ");
    break;
  case  8: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 8. Doubly defined function ");
     */
    strcat (ca_err, " 8. Doubly defined function ");
    break;
  case  9: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis," 9.");
     */
    strcat (ca_err, " 9.");
    break;
  case 10: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"10. Undefined variable in the right side: %s ", str);
     */
    sprintf (ca_err + strlen (ca_err),
	     "10. Undefined variable in the right side: %s ", str);
    break;
  case 11: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"11. More than %d chars (excess ignored) ", MAXSTR);
     */
    sprintf (ca_err + strlen (ca_err),
	     "11. More than %ld chars (excess ignored) ", MAXSTR);
    break;
  case 12: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"12. Unbalanced brackets in expression ");
     */
    strcat (ca_err, "12. Unbalanced brackets in expression ");
    break;
  case 13: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"13.");
     */
    strcat (ca_err, "13.");
    break;
  case 14: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"14. Error in EXTERNAL function declaration ");
     */
    strcat (ca_err, "14. Error in EXTERNAL function declaration ");
    break;
  case 15: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"15.");
     */
    strcat (ca_err, "15.");
    break;
  case 16: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"16. Error in a function (skipping till ';') ");
     */
    strcat (ca_err, "16. Error in a function (skipping till ';') ");
    break;
  case 17: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"17. Error in a sentence (skipping to ';') ");
     */
    strcat (ca_err, "17. Error in a sentence (skipping to ';') ");
    break;
  case 18: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"18. Parsing error ");
     */
    strcat (ca_err, "18. Parsing error ");
    break;
  case 19: 
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"19. ';' or EOF expected ");
     */
    strcat (ca_err, "19. ';' or EOF expected ");
    break;

  case 20:
	  strcat (ca_err, "20. Missed dot \'.\' before index of variable ");
	  break;

  case 100:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"100. Unbalanced left structure bracket ");
     */
    strcat (ca_err, "100. Unbalanced left structure bracket ");
    break;
  case 101:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"101. Expected '{' ");
     */
    strcat (ca_err, "101. Expected '{' ");
    break;
  case 102:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"102. Expected '}' ");
     */
    strcat (ca_err, "102. Expected '}' ");
		break;
  case 103:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"103. Expected ';' ");
     */
    strcat (ca_err, "103. Expected ';' ");
    break;
  case 104:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"104. Expected identifier ");
     */
//Was:    strcat (ca_err, "104. Expected identifier ");
       if ( str == NULL ) { strcat (ca_err, "104. Expected identifier "); } // Nemytykh, 09-09-2023
       else { sprintf (ca_err + strlen (ca_err), "104. Expected identifier instead of %c (%s)", *str, str); }
    break;
  case 105:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"105. Missing ')' (added) ");
     */
    strcat (ca_err, "105. Missing ')' (added) ");
    break;
  case 106:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"106. Expected ',' or '=' ");
     */
    strcat (ca_err, "106. Expected ',' or '=' ");
    break;
  case 107:
    strcat (ca_err, "107. Expected ':' ");
    break;
  case 108:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"108. Missing '>' (added) ");
     */
    strcat (ca_err, "108. Missing '>' (added) ");
    break;
  case 109:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"109. Expression too big ");
     */
    strcat (ca_err, "109. Expression too big ");
    break;
  case 110:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"110. Function %s in the left side of a sentence ", str);
     */
    sprintf (ca_err + strlen (ca_err),
	     "110. Function %s in the left side of a sentence ", str);
    break;
  case 111:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"111. Unbalanced < and > ");
     */
    strcat (ca_err, "111. Unbalanced < and > ");
    break;
  case 112:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"112. Unexpected > in the left side of a sentence ");
     */
    strcat (ca_err, "112. Unexpected > in the left side of a sentence ");
    break;
  case 200:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"200. Undefined function %s ",str);
     */
    sprintf (ca_err + strlen (ca_err), "200. Undefined function %s ",str);
    break;
  case 201:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"201. Doubly defined function %s ", str);
     */
    sprintf (ca_err + strlen (ca_err), "201. Doubly defined function %s (may be the function is built-in or declared in $EXTERN list) ",
	     str);
    break;
  case 202:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"202. No entry point.");
     */
    strcat (ca_err, "202. No entry point.");
    break;
  case 203:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"104. Expected identifier ");
     */
    strcat (ca_err, "203. Expected identifier ");
    break;
  case 204:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"204. Built-in function %s defined as ENTRY ", str);
     */
    sprintf (ca_err + strlen (ca_err),"204. Built-in function %s defined as ENTRY ", str);
    break;
  case 205:
/* Nemytykh 09.08.2002 */
// Was:    sprintf (ca_err + strlen (ca_err),"205. Number greater than 2^%d-1=%lu ", sizeof(int)*8,MAX_UNSIGNED_INT);
/* Nemytykh 10.05.2023 */
    sprintf (ca_err + strlen (ca_err),"205. Number greater than 2^%ld-1=%lu ", sizeof(long)*8,MAX_UNSIGNED_LONG);
    break;
  case 206:
/* Nemytykh 04.02.2023 */
    sprintf (ca_err + strlen (ca_err), "206. Unicode number exceeds U+%x ", MAX_UNICODE);
    break;
   case 207:
/* Nemytykh 04.02.2023 */
    sprintf (ca_err + strlen (ca_err), "207. Stray: %s ", str);
    break;
  
  default:
    /* Was. Shura. 27.05.99
     *    fprintf (fdlis,"System error: %4d ",code);
     */
    sprintf (ca_err + strlen (ca_err), "System error: %4d ",code);
  }

  /* Was. Shura. 27.05.99
   *  if (line_no > 0) fprintf (fdlis," on line %5d.\n", line_no);
   *  else fprintf (fdlis, "\n");
   */
  if (line_no > 0) {
    sprintf (ca_err + strlen (ca_err), " on line %5d.", line_no);
  }
  fprintf (fdlis, "%s\n", ca_err);
  fprintf (stderr, "%s\n", ca_err); /* May be to using some flag to control */
  return 0;
}

/* Nemytykh, 02-11-2022 */
void rc_prnwarn (char * warn) {
	if ( warnout ) { fprintf (stderr,warn); }
	fprintf (fdlis,warn);
	return;
}
	/* print warning  */
int rc_swarn (code)
	int  code;

	{
	char car_warn [MAX_STR_ERROR];
	
   car_warn[0] = '\0';
	rc_prnwarn ("Warning: ");
	switch (code)
		{
		case  1: 
			rc_prnwarn (" 1. Identifier too long (excess ignored) ");
			break;
		case  2: 
			rc_prnwarn (" 2. Index too long (excess ignored) ");
			break;
		case  3: 
			rc_prnwarn (" 3. ASCII value over 256 ");
			break;
		case  4: 
			rc_prnwarn (" 4. Empty string (ignored) ");
			break;
		case  5: 
/* Nemytykh 08.08.2002		fprintf (fdlis," 5. Number greater than %ld (shorten)",MAXINT);*/
         sprintf (car_warn,"5. Number greater than 2^%ld-1=%lu ", sizeof(int)*8,MAX_UNSIGNED_INT);
         rc_prnwarn (car_warn);
			break;
		case  6: 
			rc_prnwarn (" 6. The same index for 2 diff variables ");

			break;
		case  7:     /* Nemytykh 01.11.2022 */ 
			rc_prnwarn (" 7. A built-in function name in $EXTERNAL declaration");
			break;
		default: 
               sprintf (car_warn,"System warning: %4d ",code);
               rc_prnwarn (car_warn);
		break;
	};
	if (line_no > 0) { 
	       sprintf (car_warn + strlen (car_warn), " on line %5d.\n", line_no);
	       rc_prnwarn (car_warn);
	}
	else { sprintf (car_warn + strlen (car_warn), "\n");
		    rc_prnwarn (car_warn);
   }
	return 0;
	}
        
// 7777
static unsigned int u_w = 0;


# define ASCII_ST  1    /* char or string of bytes c: 'c' < 128 */      
# define UTF_ST    0    /* char or string of bytes c: 'c' > 127 */

static char st_str  = ASCII_ST,     /* state of current string */
            st_char = ASCII_ST;     /* state of the last read character */
            
static char * p_ux_enc = NULL;           /* poiter to the encoding done by '\x' and '\u', похоже, что можно сделать локальной перемнной! */ 

static char new_line_c = 0;  /* похоже, что можно избавиться от этого трюка, как в rc_ungchar_st() */

# define putin_strings(c) {\
           if ( st_char == ASCII_ST ) {\    
            strings [i ++] = c;\
           } else { ustrings [ui ++] = c; }\
        };
        
# define save_str_length(b) {\
           if ( (b) == 0 ) {\
             if ( st_char == ASCII_ST ) {\    
                 ustrings [ui] = 0; length = ui;\
             } else { strings [i] = 0; length = i;}\
 	   	  } else if ( st_char == ASCII_ST ) {\
             strings [i] = 0; length = i;\
           } else { ustrings [ui] = 0; length = ui;}\
        };

int encoding_status(char c, int i, int ui) {
	char uchar = c & 128;
	if ( uchar && (st_str == ASCII_ST) ) {
		st_str = st_char = UTF_ST;
		return UTF_ST;
	} else if ( !uchar && (st_str == UTF_ST)  ) {  
		st_str = st_char = ASCII_ST;
		return ASCII_ST;
	}
	return -1;
}

static int quote_st;
int rc_gchar_st (void) {
	int c;
	c = rc_gchar ();
	st_char = ( ((quote_st == '\'') && (c & 128)) ? UTF_ST : ASCII_ST);
	/* do not touch st_str here!!! */
	return c;
}

/* a special repeated reading cbuf-array char in order to overcome \n-rc_gchar problem -- breaking the string */
int rc_first_gchar (void) {
	int c;
	/* the first char that is to be repeatedly read is always ascii < 128 */
	if ( new_line_c ) { 
	   c = rc_gchar_st (); /* ignore this dummy char */
	   c = new_line_c;
	   new_line_c = 0;
	} 
	else { c = rc_gchar_st (); }
	return c;
}


void rc_ungchar_st (char c, int flag) {
	if ( (c == '\n') ) {
		rc_ungchar('n');
		c = '\\';
	} else if ( (c == '\\') ) {
		rc_ungchar('\\');
	} else if ( (c == quote_st) && (flag == 0) ) {
		rc_ungchar(quote_st);
		c = '\\';
	}
	rc_ungchar(c);
	return;
}


static short icnt = 0;
char rc_gchar_u (void) {

   icnt++;
   return rc_gchar();
}

void rc_ungchar_u (char c) {
	char * str = ustrings;
	str[--icnt] = c;

	return;
}

void init_char_cnt (void) {
   icnt = sc;
	return;
}


void restore_char_cnt (void) {
  sc = icnt;
  return;
}



// ****Begin***Normalization of escaped sequence ***********************************************
/* \x and \u decoding of bytes. Input: xhh | uhhhhhh , in the second case the leading zeros may be ommitted. 
   It is assumed that the input encode is a prefix of an input stream, where the h-digits still are not read.
   The function decode the escaped sequence and put the result bytes back in the stream where the result occupies
   a number of last bytes of the input h-digit secuence/
   The pointer of the stream is moved to the first byte of the result.
*/
int rc_escseq (char c) {
	int i, i_w;
   i = 0;

	char * ustr = cbuf;
	// char * str = cbuf;  // / * может ли переполниться буффер при перкодировке? Для utf-8 кажется нет ... для других перекодировок может! */
	
	init_char_cnt ();
	i = icnt;

			if (c == 'x') { 
				char c_w = 0;

				for (i_w = 0; i_w < 2; i_w ++) {
					if (EOF == (c = rc_gchar_u ())) {
						rc_serror (6, NULL);
						return 0;
					}
					if (isxdigit (c)) {
                  c = tolower(c);
				   	c = (c <= '9') ? c - '0' : (c - 'a' + 10);
						c_w += ((i_w) ? c : 16 * c);
					} else {
						rc_serror (6, NULL);
						return 0;
					}
				}
            c = c_w;
            
           if ( (c & 128) != 0 ) {            /* the utf-char encoded with \xhh */
         	   utf uc_w = r_int_to_utf(c_w);
            	p_ux_enc = r_utf_expl(uc_w);
            	ustr [i++] = * p_ux_enc;    /* three bytes xhh are replaced with two bytes of utf-8(hh) */
            	ustr [i] = * (p_ux_enc+1);  /* Here i should be without increment! */
            } else { 
 			      i++;                /* three bytes xhh are replaced with one ascii byte occuping the last position */
 			      if ( c == '\n' ) {  /* a special treatment the new line char in order to overcome \n-rc_gchar problem -- breaking the string */
 			      	c = 'n';             /* dummy char */
 			      	new_line_c = '\n';   /* the signal on the dummy char */
 			      } 
            	ustr [i++] = c;
           }
			} else if ( c == 'u' ) { // \uhhhhhh (максимум шесть шестнадцатиричных цифр, лидирующие нули разрешается опускать)
			                         /* Реальная верхняя граница: 0x10FFFF (включая это число) */
            int i_w;
   			utf uc_w;
            u_w = 0;
				
				for (i_w = 0; i_w < 6; i_w ++) {
					if (EOF == (c = rc_gchar_u ())) {
						rc_serror (6, NULL);
						return 0;
					}
					if (isxdigit (c)) {
                  c = tolower(c);
				   	c = (c <= '9') ? c - '0' : (c - 'a' + 10);
   					u_w = (u_w<<4) + c; 
					} else {
					   if( i_w > 0 ) {  rc_ungchar_u(c); break; } /* the leading h-zeros may be ommited */
 						rc_serror (6, NULL); 
						return 0;
					}
				}
				if ( (i_w == 6) && (u_w > MAX_UNICODE) ) {
					 rc_serror (206, NULL);
					 return 0;
			   }

           if ( u_w < 128 )
            {
               i += (i_w - 1);   /* three bytes xhh or thwo xh are replaced with one ascii byte occuping the last position */
 			      if ( u_w == '\n' ) {
 			      	u_w = 'n';             /* dummy char */
 			      	new_line_c = '\n';     /* the signal on the dummy char */
 			      }
               ustr [i++] = u_w;
            } else {  /* the utf-char encoded with \uhhhhhh */
          	   uc_w = r_int_to_utf(u_w);
            	p_ux_enc = r_utf_expl(uc_w);

               int j = strlen(p_ux_enc);
               strncpy (ustr + (i + (i_w - j)), p_ux_enc,j);
  		         i += (i_w - j + 1); /* !!!+++ верно работает для 2-х, 3-х и 4-х байтных utf-8 последовательностей */
             } 
		    } /* end of if ... \uhhhhhh .... */
     
  icnt = i-1;
  restore_char_cnt ();
  return 0;
}
// ****End of Normalization**************************************************


/* Nemytykh after Teriukha, 04-02-2023 */
int rc_getstr (int quote) {
	int c,i,ui;
	icnt = ui = i = 0;
	strings [0] = ustrings [0] = '\0';
	quote_st = quote;


	c = rc_gchar_st (); 
	if (c == quote) { 
		length = 0;
		strings [0] = '\0';
		return ((quote == '"')? COMPSYM: 0);
	}
	st_str = st_char;
 
	if (c == ESCAPE) { 
		if (EOF == (c = rc_gchar_st())) {  
			rc_serror (6, NULL);
			length = i;
			strings [i] = 0;
			return 0;
		}
	   if (c == '\n') {
			rc_serror (6, NULL);
			strings [i] = 0;
			return 0;
		}
		if (c == '\'' || c == '"' || c == '(' || c == ')' || c == '<' || c == '>' || c == ' ' || c == ESCAPE) {
//			c = (char) c;  // Nothing to do at this point!
		} else if (c == 'n') { c = '\n';
		} else if (c == 'r') { c = '\r';
		} else if (c == 't') { c = '\t';
		} else if (c == 'x' || c == 'u' ) {
         rc_escseq(c);

         c = rc_first_gchar(); /* a special repeated reading in order to overcome \n-rc_gchar problem -- breaking the string */ 
		} else {
				rc_serror (6, NULL);
		}
	} else { /* end of if ...ESCAPE... */
	}
 
	if( (quote == '\'') && (encoding_status(c,i,ui) > -1) ) {
// printf("\n Меняем кодировку на: st_str = %d, st_char = %d",st_str,st_char);
		/* --- похоже здесь не надо проверять на пустоту, поскольку это первый символ и прочитанная строка пустая */
		if( ((st_str == ASCII_ST) && (ui != 0)) || ((st_str == UTF_ST) && (i != 0)) ) {
  			save_str_length(0);
	      rc_ungchar_st (c,0);     // put the char c back to the buffer for reading; the rc_gchar_st() will treat the char as a syntactical item, 
			rc_ungchar_st (quote,1); // while the quote will be trated as a semantical item.
         return ((st_str == ASCII_ST) ? MSTRING : STRING) ;
		} 
	}
   putin_strings(c);


	while ( ( (c = rc_gchar_st ()) != EOF) && (c != '\n')) {  
	
		if (c == ESCAPE) {
			if (EOF == (c = rc_gchar_st())) {
				rc_serror (6, NULL);
				length = i;
				strings [i] = 0;
				return 0;
			}
			if (c == '\n') {
				rc_serror (6, NULL);
				strings [i] = 0;
				return 0;
			}
			if (c == '\'' || c == '"' || c == '(' || c == ')' || c == '<' || c == '>' || c == ' ' || c == ESCAPE) {
//			c = (char) c;  // Nothing to do!
		} else if (c == 'n') { c = '\n';
		} else if (c == 'r') { c = '\r';
		} else if (c == 't') { c = '\t';
		} else if (c == 'x' || c == 'u' ) {
         rc_escseq(c);
         c = rc_first_gchar(); /* a special repeated reading in order to overcome \n-rc_gchar problem -- breaking the string */ 
		} else {
				rc_serror (6, NULL); 
		}
/* *************здесь уже не попали в ESCAPE  ********************************************** */
		/* --- положить символ и проверить его статус кодировки ---!!! */
	if(  (quote == '\'') && (encoding_status(c,i,ui) > -1) ) {
			// !! обрабатывает пустую строку !!!
		if( ((st_str == ASCII_ST) && (ui != 0)) || ((st_str == UTF_ST) && (i != 0)) ) 
		{
  			save_str_length(0);
	      rc_ungchar_st (c,0); 
			rc_ungchar_st (quote,1); 
         return ((st_str == ASCII_ST) ? MSTRING : STRING) ;
		}
	}
   putin_strings(c);

	} else if (c == quote) { /* end of if ...ESCAPE... */  // Teriukha
// *****************************************************************************************
      	if(  (quote == '\'') && (encoding_status(c,i,ui) > -1) ) { 
  		        save_str_length(0);
              return ((st_str == ASCII_ST) ? MSTRING : STRING) ;
  		   } 
  		    save_str_length(1);
	       return ((quote == '\'') ? ((st_str == ASCII_ST) ? STRING : MSTRING) : COMPSYM);
		} else {
/* *************здесь уже не попали в ESCAPE  и  не кавычка ********************************************** */
	if(  (quote == '\'') && (encoding_status(c,i,ui) > -1) ) {
			// !! обрабатывает пустую строку !!!
		if( ((st_str == ASCII_ST) && (ui != 0)) || ((st_str == UTF_ST) && (i != 0)) ) 
		{
  			save_str_length(0);
	      rc_ungchar_st (c,0); 
			rc_ungchar_st (quote,1); 
         return ((st_str == ASCII_ST) ? MSTRING : STRING) ;
		}
	}
   putin_strings(c);
/* *********************************************************** */
// *****************************************************************************************

		}
	} /* end of while */
	rc_serror (6,NULL);
	if ( st_str == ASCII_ST ) length = i; 
	else { length = ui; }
   putin_strings('\0');
	return 0;
}


	/* get number with the first digit d. */
int rc_getnumb (d)
	int d;
	{
	int c, warning;
	unsigned long i;
//Was:	unsigned long k = (unsigned long)MAX_UNSIGNED_INT; , Nemytykh 10.05.2023
//   unsigned long k = (unsigned long)MAX_UNSIGNED_LONG;

	i = d - '0';
	warning = 0;
	c = rc_gchar ();
	while (isdigit (c))
		{
	/* The next few lines are strange because otherwise the "C" compiler
		produces an integer overflow warning */
/* Nemytykh 10.05.2023 */
		if ( warning || (i > 0) ) { warning = 1; }
      i = i*10 + (c - '0');
		c = rc_gchar ();
		};
	globsav = (char)c;
	v = i;
/* Nemytykh 09.08.2002 */
// Was:	if (warning) rc_serror (205, NULL);  /* Was: rc_swarn (5); */
/* Nemytykh 10.05.2023, the warning signals on overflow: */
   if (warning && (i == 0)) rc_serror (205, NULL); 
	return NUMBER;
	}


