 
#ifdef FOR_OS_WINDOWSNT
#	include <sys/timeb.h>
#endif

# include "decl.h"
# include "macros.h"
# include "fileio.h"
# include "ifunc.h"

// Nemytykh, 27.09.2022
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
 
#include "version.h"

#ifdef FOR_OS_WINDOWSNT
/* For _stat () */
#	include <sys/types.h>
#	include <sys/stat.h>
/* For _getcwd () */
#	include <direct.h>
/* For getpid () */
#	include <process.h>
#else
/* For stat () */
#	include <sys/stat.h>

/* For stat (), getcwd () */
#	include <unistd.h>

/* For 	WIFEXITED, WEXITSTATUS */
#	include <sys/types.h>
#	include <sys/wait.h>

#       define  MAX_PATH_LEN 1024
#       ifdef FOR_OS_DOS
#               define _MAX_PATH 1024
#       endif
#endif

#	define MAX_SYSTEM_CALL 1024

#include <time.h>
#include <errno.h>

# define MDEBUG 0
# define MDEBUG1 0

  /* For translator pgraph */
extern unsigned long ul_local_calls;
extern int flag_local_calculation;


int rf_prout (char outputUNPR)
	/* RF_PROUT prints its argument onto standart output file
		and returns empty. Format :
		<Prout  e.arg>	*/

	{
	check_freeze;

   outUnprn = outputUNPR; 
	if (NEXT(b1) != b2) ri_put (stdout,std_streem_fmodes[R_STDOUT]);
	outUnprn = YES;
   putc ('\n', stdout); 
	rdy (0);
	out (2);
	est;
	return 0;
	}


int rf_put ()
	/* RF_PUT prints the second argument onto file REFALxx.DAT, 
		where xx is the first argument (must be a MACRODIGIT)
		and returs the second argument. Format :
		<Put s.digit e.expr>	*/

	{
	int i;
	char s [11], mode;
	FILE *f;

	check_freeze;

	b1 = b1->foll;
	if (!LINK_NUMBER (b1)) goto restart;
	i = (b1->pair.n) % FILE_LIMIT;
	if (i == 0) f = stderr;
	else
		{
		if (file_table [i] == NULL)
			{
			sprintf (s, "REFAL%d.DAT", i);
			ri_open (i, "w", s);
			};
		f = file_table [i];
      mode = fmode_table [i][1];
		if( (f == stderr) ) mode = std_streem_fmodes[R_STDERR];
		};
	tbel (3) = ((b1->foll == b2) ? NULL : b1->foll);
	tbel (4) = b2->prec;
	if (tbel (3) != NULL) ri_put (f,mode);
	putc ('\n', f);
	rdy (0);
	tple (4);
	out (2);
	est;
	return 0;

	restart:
		return ri_imp ();
	}


/* BR: transplant the argument to the stock.	
   Format: <Br e.Name'=' e.Expr> 
*/
int rf_br (void) {
	LINK * lnkp_w;

	check_freeze;

	/* Check arguments */
	for (lnkp_w = b1 -> foll; lnkp_w != b2; lnkp_w = lnkp_w -> foll) {
		if (LINK_CHAR (lnkp_w) && lnkp_w -> pair.c == '=') {
			break;
		}
	}

/*
	if (lnkp_w == b2) {
		ri_error (8);
		exit (1);
	}
*/
	if (lnkp_w == b2) goto restart;

	cl;
	b = stock;
	rend = b->foll;
	bl;
	tple (4);
	br;
	weld (b, rend);
	rdy (0);
	out (2);
	est;
	return 0;

	restart:
		return ri_imp ();
}


int rf_putout (char outputNL)
	/* RF_PUTOUT prints the second argument onto file REFALxx.DAT, 
		where xx is the first argument (must be a MACRODIGIT)
		and returns the empty. Format :
		<Putout s.first e.second>	*/

	{
	int i;
	char s [11], mode;
	FILE *f;

	check_freeze;

	b1 = b1->foll;
	if (!LINK_NUMBER (b1)) goto restart;
	i = (b1->pair.n) % FILE_LIMIT;
	if (i == 0) f = stderr;
	else
		{
		if (file_table [i] == NULL) {
			sprintf (s, "REFAL%d.DAT", i);
			ri_open (i, "w", s);
 		} else if( !((fmode_table [i][0] == 'w') || (fmode_table [i][0] == 'a')) ) {
			fprintf(stderr,"can\'t write the file associated with descriptor %d, open as \'%c\'.\n",i, fmode_table [i][0]);
			goto restart;
		}
		f = file_table [i];
      mode = fmode_table [i][1];       /* The order of this and the following lines does matter. */
		if( (f == stderr) ) mode = std_streem_fmodes[R_STDERR];
		};
	tbel (3) = ((b1->foll == b2) ? NULL : b1->foll);
	tbel (4) = b2->prec;
	if (tbel (3) != NULL) ri_put (f,mode);
	if (outputNL == YES) putc ('\n', f);
	rdy (0);
	out (2);
	est;
	return 0;

	restart:
		return ri_imp ();
	}


int rf_card (void) {
	char mode;

	check_freeze;
   mode = is_get_option(0); /* The arguments signals on a call from an input function. */
	if (IS_IMP(mode)) goto restart; 
	cl;
	
	/*Was: if (tbel (3) == NULL) / * no argumets * /, Nemytykh 28.09.2022 */
	if ( (tbel (3) == NULL) || LINK_COMPSYM (PREV(b2)) ) /* no argumets or only s.mode , Nemytykh 28.09.2022 */
   { 
       return ri_get (stdin,mode);
   }
   else
   restart:
	     return ri_imp ();
}

/* RF_PRINT prints its argument onto standart output file and returns the argument. 
   Format : <Print  e.arg> */
int rf_print (void) {
	check_freeze;

	tbel (3) = ((b1->foll == b2) ? NULL : b1->foll);
	tbel (4) = b2->prec;
	if (tbel (3) != NULL) ri_put (stdout,std_streem_fmodes[R_STDOUT]);
	putc ('\n', stdout);
	rdy (0);
	tple (4);
	out (2);
	est;
	return 0;
}

/*
static int
is_function (char * cp_id) {
	char ** cpp_w, * cp_func;

	for (cpp_w = local_functions; * cpp_w != NULL; cpp_w ++) {
		for (cpp_w ++; * cpp_w != NULL; cpp_w ++) {
			for (cp_func = (* cpp_w) - 2; * cp_func != 0; cp_func --);
			cp_func ++;
			if (0 == strcmp (cp_func, cp_id)) {
				return 1;
			}
		}
	}
	return 0;
}
*/

/*   Format : <Type e.Expr> => s.Type s.Subtype e.Expr  */
int rf_type (void) {
	char c [3] = {'\0', '0', '\0'}, x, i;
	utf u;
	cl;
	if (tbel (3) == NULL) c [0] = '*';
	else {
		x = tbel (3)->ptype;
		switch (x) {
		case LINK_TYPE_LSTRUCTB:
			c [0] = 'B';
			break;
		case LINK_TYPE_CHAR:
			i = tbel (3)->pair.c;
			if (isupper(i)) {
				c [0] = 'L'; c [1] = 'u';
			} else if (islower(i)) {
				c [0] = 'L'; c [1] = 'l';
			} else if (isdigit(i)) {
				c [0] = 'D';
			} else if (' ' <= i && i <= 127) {
				c [0] = 'P';
				c [1] = (isupper (i))? 'u': 'l';
			} else {
				c [0] = 'O';
				c [1] = (isupper (i))? 'u': 'l';
			}
			/*
			ascii = ((line[i] & 128)? 0 : 1)
			utf = 0xc0 & c[0] == 0xc0
			*/
			break;
		case LINK_TYPE_COMPSYM:
			c [0] = 'W';
/*  Nemytykh		if (isalpha (tbel (3) -> pair.f [0])) { */
			if (isIdentifier  (tbel (3) -> pair.f )) { 
				c [1] = 'i';
			} else {
				c [1] = 'q';
			}
			break;
		case LINK_TYPE_NUMBER:
			c [0] = 'N';
			break;
		case LINK_TYPE_MSYMBOL:
			u = tbel (3)->pair.u;
			
			c [0] = 'U'; c [1] = ri_alphabet(u); /* Nemytykh */
			        /* c [0] = 'U' -- UTF-8 ;  
			           c [0] = 'H' is reserved for UTF-16 ;
			           c [0] = 'F' is reserved for UTF-32 ;
			           Here it should checked what is the unicode type is used.
			           May be the correct result should be: Type 'U' Subtype '8' -- UTF-8; 
			                                                        Subtype '6' -- UTF-16; -- The last digit of the name.
			                                                        Subtype '2' -- UTF-32; -- The last digit of the name.
			                                                        Subtype 'u' -- Unicode numbering
			        */
			break;
		case LINK_TYPE_SVAR:
		case LINK_TYPE_TVAR:
		case LINK_TYPE_EVAR:
                case LINK_TYPE_MLSTRUCTB:
                        return ri_frz (1);
/*
		case LINK_TYPE_SVAR:
			c [0] = 'S';
			break;
		case LINK_TYPE_EVAR:
			c [0] = 'E';
			break;
		case LINK_TYPE_TVAR:
			c [0] = 'T';
*/
		default:
			ri_error(10);
			return 1;
		}
	}
	rdy (0);
	{
		int i_w;

		for (i_w = 0; c [i_w] != '\0'; i_w ++) ns (c [i_w]);
	}
	tple (4);
	out (2);
	est;
	return 0;
}

/*
void ri_cs(char * str) {
	char *pc = ri_cs_impl (str);
	rdy (0);
	ncs (pc);
	return;
}
*/
void ri_cs(char * str) {
	char *pc = ri_cs_impl (str);
	ncs (pc);
	return;
}

void empty_parenthesis(void) {
	bl; br;
	return;
}
/*   Format : <UType s.Usymbol> => s.Alphabet s.Language s.Subtype e.Other  
      s.Subtype ::= s.UpperRegister | s.LowRegister | s.Numeral ...
*/
int rf_utype (void) {
	char x;
	
	all;
	cl;
   rdy (0);
	if (tbel (3) == NULL) {
       ri_cs("Empty");
       empty_parenthesis();
	} 
	else {
		x = tbel (3)->ptype;
		switch (x) {
		case LINK_TYPE_MSYMBOL:
			ri_cs("UChar");
			ri_alpha_props(tbel (3)->pair.u);
			break;
		case LINK_TYPE_CHAR:
			ri_cs("ASCII");
			empty_parenthesis();
			break;
		case LINK_TYPE_COMPSYM:
			ri_cs("Word");
			empty_parenthesis();
			break;
			
		default:
			ri_cs("Other");
			empty_parenthesis();
		}
	}
	tple (4);
	out (2);
	est;
	return 0;
}

void ri_alpha_props (utf u) {
	char * p;
		
	bl;
	ri_cs(ri_alphabet_s(u));
	if ( u == ri_tolower (u) ) { ri_cs("Lower"); }
	else { ri_cs("Upper"); }

	if ( ri_isIndex(u) ) {
		ri_cs("Index");
		ri_cs( IndexCase(u) );
		ri_cs( IndexAlphabet(u) );
	} else { 
	   p = ri_NumericType(u); 
	   if ( p != NULL ) { 
	      ri_cs("Numeric");
	      ri_cs(p); 
	      p = ri_DigitType(u);
	      if ( p != NULL ) ri_cs( p );
	      else goto Other;
	} 
	int i = ri_isWhiteSpace(u);
	if ( i > 0 ) { 
	   p = ri_WhiteSpaceType(u);
	   if ( p != NULL ) { 
	      ri_cs("WhiteSpace");
	      ri_cs(p); 
	      if( i == 1 ) { p = ri_WhiteSpaceWidth(u);
	                     if ( p != NULL ) ri_cs( p );
	                     else goto Other; }
	      else { u = ri_WhiteSpaceLength(u);
	             mns(u); }
	      /* else goto Other; */
/*	   } else {
	   	if ( u == ri_tolower (u) ) { ri_cs("Lower"); }
	   	else { ri_cs("Upper"); } */
 /* utf ch = ri_toupper (b1->pair.u); */
 /*        ri_tolower (u); */
	   } else {
	     Other: ri_cs("Other");
	   }
	}
   }
	br;
	return;
}


/*   Format : <Dg e.Name> => e.Expr  */
int rf_dg ()
	{
	LINK *end;

	check_freeze;
/*	check_frz_args (1); Nemytykh 02.02.2006 */

	cl;
	b1 = stock->foll;
	end = stock->pair.b;
	while (b1 != end)
		{
		tbel (5) = b1;
		tbel (6) = b2 = b1->pair.b;
		nel=7;
		oexp (4);
		sym ('=');
		cl;
		rdy (0);
		tple (11);
		out (2);
		b = tbel (5)->prec;
		out (6);
		est;
		return 0;

	restart:  
		sp++;
		b1 = tbel (6)->foll;
		};

	rdy (0);
	out (2);
	est;
	return 0;
	}

/*   Format : <Get s.digit> => e.Expr  */
int rf_get ()
	{
	/*register*/ int i;
	char s [11];
	char mode;

   check_freeze;
	b1 = b1->foll;
   mode = is_get_option(1); /* The argument signals on this call from the input function. */
	if ( ! LINK_NUMBER (b1) || IS_IMP(mode) )  goto restart;
	i = (b1->pair.n) % FILE_LIMIT;
	if (i == 0) ri_get (stdin, mode);
	else
		{
		if (file_table [i] == NULL)
			{
			sprintf (s, "REFAL%d.DAT", i);
			ri_open (i, "r", s);
			};
		if( fmode_table [i][0] != 'r' ) {
			fprintf(stderr,"can\'t read the file associated with descriptor %d, open as \'%c\'.\n",i, fmode_table [i][0]);
			goto restart;
		}
		if(mode == ENC_UNKNOWN) mode = fmode_table [i][1];
		ri_get (file_table [i], mode);
		};
	return 0;

	restart:
		return ri_imp ();
	}


/* Format : <Arg s.digit> => e.Expr */
/* Nemytykh, 21-03-2023 */
int rf_arg ()
	{
	/*register*/ int i, ln;
	char *c;
	char mode;

   check_freeze;
	b1 = b1->foll;
   mode = is_get_option(1); /* The argument signals on this call from the input function. */
//?   mode = is_get_option(0); /* The argument signals on a call from the explode function. */
	if ( ! LINK_NUMBER (b1) || IS_IMP(mode) )  goto restart;
	rdy (0);
	
	i = b1->pair.n;
	if(i < gargc) {
   	if( mode == ENC_FLAT ) { 
   	  	for (c=garg [i]; *c != '\0'; c++) { 
       	  if ( * c < 128 ) 
              { ns (* c); }                   /* byte ASCII char     */
           else {                             /* unicode char        */
		          utf u = r_int_to_utf(* c);
		          mns (u);
           }
  	      }
   	}
   	else {  /* I.e., this mode is by default. */ 
		   for (c=garg [i]; *c != '\0'; c++) {
			   ln = ri_getc (c, ENC_NONFLAT);
			   c += ln;
		   }
	   }
	} 
	
	out (2);
	est;
	return 0;

	restart:
		return ri_imp ();
	}

char *mu_find (char *str, char **pi) {
	char *pc;

	/*pi ++;*/ /* skip the title. */
	for (pi ++; *pi != NULL; pi ++) {
		pc = *pi;

		if (pc [-1] != '\0') {
			fprintf (stderr, "WARNING: Uncorrect format names(MU_FIND)\n");
		}
		for (pc -= 2; * pc != '\0'; pc --);
		pc ++;

		/*if (strncmp (str, pc - MAXWS, MAXWS) == 0) return pc;*/
		if (strcmp (str, pc) == 0) {
			for (; * pc != '\0'; pc ++);
			pc ++;
			return pc;
		}
		/*pi ++;*/
	}
	return NULL;
}
	
/* RF_MU accepts 2 formats:
 *	<Mu (e.STRING) e.ARG>
 *	<Mu s.SYMBOL e.ARG>
 * The result is <F e.ARG>, where F is the function whose name
 * is the same as the STRING in the first case or SYMBOL in the second.
 */
/* pointer to the beginning of the list of functions visible from this module. */
int rf_mu (char ** muaddr, int freeze_flag) {
	char str [MAXWS+1], *pc;
	int i;

	if (freeze_flag) check_freeze;
	i = 0;
	b1 = b1->foll;
	if (LINK_VAR (b1) || GPAR (b1)) goto call_freeze;
	/* first format */
	if (LINK_LSTRUCTB (b1)) {
		b1 = b1 -> foll;
		if ( LINK_CHAR (b1) && mu_special (str, b1->pair.c) == 0) {/* special symbol */
			b1 = b1 -> foll;
			i++;
		} else {
	   	/* copy the string into array str []; */
	   	for ( ; LINK_CHAR (b1) || LINK_MSYMBOL (b1) ; b1 = b1 -> foll) {
	   		

/*     Actually the final decision will take mmu_find function. It means that the following checking may be omitted. Nemytykh 18-04-2023
            c = b1->pair.c;
		   	if (isalnum (c) || c == '_' || c == '$' || c == '-' || isdigit (c)) str [i++] = c;
		   	else goto call_ri_imp;
*/		   	
            if (LINK_CHAR (b1)) str [i++] = b1->pair.c;
            else /* if(LINK_MSYMBOL (b1))*/ { 
			     int j = ri_utf_explode(b1 -> pair.u, (char *)str + i, MAXWS-i);
			     if ( j == -1 ) { return ri_frz (3); }
		        else { i += j+1; }
            }

/* Nemytykh 08.10.2019, Was:			if (i >= MAXWS) return ri_error (7); */
                        if (i >= MAXWS) return ri_frz (3);  
	   	}
		   str [i] = '\0';
	   }
		if (LINK_VAR (b1) || GPAR (b1)) goto call_freeze;
		/* check that the string is not empty. */
		if (i == 0) goto call_ri_imp;
		/* check that b1 now points to a right parenthesis. */
		if (!LINK_RSTRUCTB (b1)) { goto call_ri_imp; }
	} else if (LINK_COMPSYM (b1)) { /* second format */
	   if ( (mu_special (str, *(b1->pair.f)) == 0) && (*((b1->pair.f)+1) == '\0') ) {
	   	;
	   } else {
/* The following checking may be omitted as well. See a comment above. Nemytykh 18-04-2023. */	   	
	   	if ( isIdentifier (b1 -> pair.f) == 1 ) {
            strcpy (str, b1->pair.f);
	   	} else { goto call_ri_imp; };
	   }
	} else if (LINK_SYMBOL (b1) && mu_special (str, b1->pair.c) == 0) {/* special symbol */
		;
	} else { /* we got here if the function with the same name was not found. */ 
/* Nemytykh 07.10.2019
 Was:		ri_error (7);
		return 1;
*/
		call_ri_imp: return ri_imp ();
	}
	/* Now b1 points just before the argument. e.ARG. */
	cl;
	/* Get the address of the function stored in str. */
	pc = mu_find (str, muaddr);
	if (pc == NULL) pc = mu_find (str, entry_functions);
	if (pc != NULL) {
		/* the function is found. */
		rdy (0)
		bl;
		tple (4);
		br;
		act1 (pc);
		out (2);
		est;
		return 0;
	} else {/* we got here if the function with the same name was not found. */
		ri_error (7);
		return 1;
	}

call_freeze:

	return ri_frz (1);
}

	/* check if c_value is a special acceptable value for arithmetic
		function. Return 0 if success, 1 = failure
		Important: if FAIL, do NOT overwrite s_value */

int mu_special (char *s_value, char c_value) {
	switch (c_value) {
	case '+':
		strcpy (s_value, "Add");
		break;

	case '-':
		strcpy (s_value, "Sub");
		break;

	case '*':
		strcpy (s_value, "Mul");
		break;

	case '/':
		strcpy (s_value, "Div");
		break;

	case '%':
		strcpy (s_value, "Mod");
		break;

	case '?':
		strcpy(s_value, "Residue");
		break;

	default:
		return 1;	/* failure */
	}
	return 0;	/* success */
}


/*   Format : <GetEnv e.characters> => e.Expr  */
int rf_getenv (void) {
	char ca_buf [120];
	char * cp;

	check_freeze;

	for (cp = ca_buf, b1 = b1->foll; b1 != b2; b1 = b1 -> foll, cp ++) {
		if (! LINK_CHAR (b1)) return ri_imp ();
		* cp = b1 -> pair.c;
	}
	* cp = 0;
	rdy (0);
	if (NULL != (cp = getenv (ca_buf))) {
		for (; * cp != 0; cp ++) ns (* cp);
	}
	out (2);
	est;
	return 0;
}

/* Get current process id. A.A. Vladimirov 10.10.2004 */
/*   Format : <GetPID> => s.number  */
int rf_getpid (void) {

	check_frz_args (1);

	b1 = b1->foll;
	if (b1 != b2) return ri_imp ();
	rdy (0);

	nns ((unsigned long) getpid());
	out (2);
	est;
	return 0;
}

/* Get parent process id. A.A. Vladimirov 10.10.2004.
   This function is undefined under Windows operating sysytem.
   In fact, it returns current process id. 
*/
/*   Format : <GetPPID> => s.number  */
int rf_getppid (void) {
        unsigned long i;

	check_frz_args (1);

	b1 = b1->foll;
	if (b1 != b2) return ri_imp ();
	rdy (0);
# ifdef FOR_OS_WINDOWSNT
	i = (unsigned long) getpid();
# else
	i = (unsigned long) getppid();
# endif
        nns(i);
	out (2);
	est;
	return 0;
}

# define ustr_arg(n) 	for (b1 = b1->foll, i=0; (b1 != b2); b1 = b1->foll)\
                     	{  if (i == (n)) return ri_error (1);\	
                     	   if (LINK_CHAR (b1)) { ca_buf[i++] = b1->pair.c; }\
		                     else if(LINK_MCHAR (b1)) {\
			                     cp = r_utf_expl(b1->pair.u);\
			                     while (*cp) { ca_buf[i++] = *(cp++); }\
		                     } else ri_imp ();\
	                     }\
	                     ca_buf [i] = 0;

/*   Format : <System e.characters> => s.number  */
int rf_system (void) {
	char ca_buf [MAX_SYSTEM_CALL+1];
	int i;
	char * cp;

	check_freeze;
   ustr_arg(MAX_SYSTEM_CALL); /* Nemytykh, 24-02-2023	*/
	i = system (ca_buf);

#ifdef FOR_OS_LINUX
	/* madmax */
	if (WIFEXITED (i) != 0) {
		i = WEXITSTATUS (i);
	} else {
		i = 1;
	}
#endif

	rdy (0);

	if (i < 0) {
		ns ('-');
		i = abs(i);
	}
	nns (i);
	out (2);
	est;

	return 0;
}

extern FILE* ref_err_file();
#ifdef FOR_OS_WINDOWSNT
	extern void ri_information (struct _timeb, int);
#else
	extern void ri_information (long, int);
#endif
/*   Format : <Exit e.return-code>, 
     where e.return-code ::= s.number | '-' s.number | '+' s.number  */
int rf_exit (void) {
	int i = 1, j;
#ifdef FOR_OS_WINDOWSNT
	struct _timeb l_t;
	
	_ftime (& l_t);
#else
   long l_t = time (NULL); 
#endif

	check_freeze;

	b1 = b1 -> foll;
	if (LINK_CHAR (b1)) {
		if (b1 -> pair.c == '-') {
			i = -1;
		} else if (b1 -> pair.c == '+') {
			i = 1;
		}
		b1 = b1 -> foll;
	} else {
		i = 1;
	}
	if (! LINK_NUMBER (b1) || (NEXT(b1) != b2)) return ri_imp ();
	i *= b1 -> pair.n;

	rdy (0);
	/* Print all informations which are wanted to see to user */
	ri_information (l_t, 0);

	for (j = 0; j < FILE_LIMIT; j ++) {
		if (file_table [j] != NULL) {
			fclose (file_table [j]);
		}
	}

	exit (i);
	out (2);
	est;
        return 0;
}

/*   Format : <Close s.digit> => empty */
int rf_close (void) {
	int i;

	check_freeze;

	b1 = b1 -> foll;
	if (! LINK_NUMBER (b1) || (NEXT(b1) != b2))  
                return ri_imp ();
	i = b1 -> pair.n % FILE_LIMIT;
	if (NULL != file_table [i]) {
		fclose (file_table [i]);
		file_table [i] = NULL;
	}
	b1 = b2;
	rdy (0);
	out (2);
	est;
	return 0;
}


/*   Format : <ExistFile e.name-string> => s.Boolean */
int rf_existfile (void) {
	char ca_buf [FILENAME_MAX+1];
	char * cp;
	int i;

	check_freeze;

   ustr_arg(FILENAME_MAX); /* Nemytykh, 24-02-2023	*/
   
	{
#ifdef FOR_OS_WINDOWSNT
		struct _stat st_buf;

		if (0 == _stat (ca_buf, & st_buf)) {
			/* Exist */
/* Was:			if (st_buf.st_mode & _S_IFREG) { */
			if ( (st_buf.st_mode & _S_IFREG) || (st_buf.st_mode & _S_IFDIR) ) {  /* Nemytykh, 25-02-2023	*/
				cp = ri_cs_impl ("True");
			} else {
				cp = ri_cs_impl ("False");
			}
		} else {
			cp = ri_cs_impl ("False");
		}
	#else
		struct stat st_buf;

		if (0 == stat (ca_buf, & st_buf)) {
			/* Exist */
/* Was:			if (st_buf.st_mode & S_IFREG) { */
			if ( (st_buf.st_mode & S_IFREG) || (st_buf.st_mode & S_IFDIR) ) {   /* Nemytykh, 25-02-2023	*/
				cp = ri_cs_impl ("True");
			} else {
				cp = ri_cs_impl ("False");
			}
		} else {
			cp = ri_cs_impl ("False");
		}
#endif

	}
	rdy (0);
	ncs (cp);
	out (2);
	est;
	return 0;
}

/*   Format : <GetCurrentDirectory> => e.characters  */
int rf_getcurrentdirectory (void) {
	int i;

#ifdef FOR_OS_WINDOWSNT
	char ca_curdir [_MAX_PATH];

	check_freeze;

	if (NEXT(b1) != b2) return ri_imp ();
	if (NULL == _getcwd (ca_curdir, _MAX_PATH)) {
		fprintf (stderr, "WARNING: Cannot get a current directory\n");
		ca_curdir [0] = 0;
	}
#else
	char ca_curdir [MAX_PATH_LEN];

	check_freeze;

	if (NEXT(b1) != b2) return ri_imp ();
	if (NULL == getcwd (ca_curdir, MAX_PATH_LEN)) {
		fprintf (stderr, "WARNING: Cannot get a current directory\n");
		ca_curdir [0] = 0;
	}
#endif

	rdy (0);
	for (i = 0; ca_curdir [i] != 0; i ++) {
		ns (ca_curdir [i]);
	}
	out (2);
	est;
	return 0;
}


/*   Format : <RemoveFile e.file_name-string> => s.Boolean (e.Errors) */
int rf_removefile (void) {
	char ca_buf [FILENAME_MAX+1], * cp, * cp_err;
	int i;

	check_freeze;

   ustr_arg(FILENAME_MAX); /* Nemytykh, 24-02-2023 */

/* Actually this function is able to remove an empty directory, since no validation on ordinary file is done.
   (See the function ExistFile above), Nemytykh, 25-02-2023 )
*/
	if ((b1 != b2) || (-1 == remove (ca_buf))) {
		cp = ri_cs_impl ("False");
        	if (b1 != b2) 
                {
		             b1 = b2;
                   cp_err = "File name is too long.\0";
	              }
                else cp_err = strerror (errno);
	} else {
		cp = ri_cs_impl ("True");
		cp_err = NULL;
	}
	rdy (0);
	ncs (cp);
	bl;
	if (cp_err != NULL) {
		for (i = 0; cp_err [i] != 0; i ++) {
			ns (cp_err [i]);
		}
	}
	br;
	out (2);
	est;
	return 0;
}

/* Nemytykh */
/*   Format : <Implode_Ext e.string e.expr> => s.compound_symbol-string */
int rf_implodeExt (void) {
	char ca_str [MAXWS + 1], * cp_w;
	int i, j;

	for (i = 0, b1 = b1 -> foll; i < MAXWS && b1 != b2; i ++, b1 = b1 -> foll) {
		if (LINK_VAR (b1) || GPAR (b1)) {
			return ri_frz (1);
		} else if (LINK_CHAR (b1)) {
		   ca_str [i] = b1 -> pair.c;
		} else if (LINK_MSYMBOL (b1)) {
			j = ri_utf_explode(b1 -> pair.u, (char *)ca_str + i, MAXWS-i);
			if ( j == -1 ) { goto err; }
			else { i = i + j; }
		} else break;
	}
	if (i == MAXWS && b1 != b2) {
             err: return ri_error (15);
	}
	ca_str [i] = 0;
	cp_w = ri_cs_impl(ca_str);
	rdy (0);
	ncs (cp_w);
	out (2);
	est;
	return 0;
}


/* The expression between p and q (both are not included) is not empty. */
char is_not_empty(LINK *p, LINK *q) {
	for (p = NEXT(p); p != q; p = NEXT(p)) {
		if ( !(LINK_EVAR (p) || EPAR (p)) ) return 1;
	}
        return 0;
}

/*  Nemytykh, 29.09.2022 */
/* Flat --- Nonflat */
char is_get_option(char req) {
	char * opt;
	char mode;
	LINK *p;
   mode = (req == 0) ? ENC_NONFLAT : ENC_UNKNOWN; /* I.e., this mode is by default. */
	
	p = (req == 1) ? PREV(b2) : NEXT(b1); /* see the definition of the calling functions */
	if ( LINK_COMPSYM (p) ) { /* s.mode - input value, the last argument   */
		opt = p->pair.f;
		if ( strcmp(opt,"Flat") == 0 )        mode = ENC_FLAT;
		else if( strcmp(opt,"Nonflat") == 0 ) mode = ENC_NONFLAT; 
		else { 
		  // b2 = NEXT(b2);
		  mode = IMP; 
		}
	} 
 	return mode;
}

/* Nemytykh, 22-09-2022. */
/*   Format : <Explode_Ext s.compound_symbol-string> => e.string */
int rf_explodeExt (void) {
	char mode;

	b1 = NEXT(b1);
	if (LINK_VAR (b1) || GPAR (b1)) return ri_frz (1);
	else {
		mode = is_get_option(0); /* The argument signals on a call from the explode function. */
	}
	if (! (LINK_COMPSYM (b1) || LINK_MSYMBOL (b1)) || IS_IMP(mode)) return ri_imp ();
	rdy (0);
	
	if( mode == ENC_FLAT ) { ri_explodeExtFlat(); }
	else { ri_explodeExtNonflat(); /* I.e., this mode is by default. */ }
	
	out (2);
	est;
	return 0;
}

void ri_explodeExtNonflat (void) {
	char * cp_w;
//	utf symb;
	int ln;

	if( LINK_COMPSYM (b1) ) { /* Nemytykh, 21-09-2022 */
		cp_w = b1 -> pair.f;
		for ( ; (* cp_w != 0) ; cp_w ++) {
			ln = ri_getc (cp_w, ENC_NONFLAT);
			cp_w += ln;
		}
	} else { /* IS MSYMBOL */
      rend = NEXT(NEXT(b));
      TYPE(lfm) = TYPE(rend); 
      PAIR(lfm) = PAIR(rend);
      ns1;
   }
	return;
}

void ri_explodeExtFlat (void) {
	char * cp_w;
	utf u;

	cp_w = LINK_COMPSYM (b1) ? b1 -> pair.f : r_utf_expl(b1 -> pair.u); /* Nemytykh, 21-09-2022 */
  	for ( ; * cp_w != 0; cp_w ++) { 
     	 if ( * cp_w < 128 ) 
       { ns (* cp_w); }                   /* byte ASCII char     */
       else {                             /* unicode char        */
		   u = r_int_to_utf(* cp_w);
		   mns (u);
       }
  	}
	return;
}

/*   Format : <TimeElapsed e.init> => e.char-digits '.' e.char-digits 
     , where e.init ::= 0 | empty
       e.char-digits ::= s.digit1 a.digit2 s.digit3 
*/
int rf_timeElaps (void) {
	char /* * cp_time,*/ cu_refTime [50];
	unsigned long curr_time;
   int i;
	
	sprintf (cu_refTime, "%lu.%03u", (long) 0,0); /* temprary definition for uknown oper. systems */
#ifdef FOR_OS_WINDOWSNT
	/* char /-* * cp_time,*-/ cu_refTime [50]; */
	int i;
	struct _timeb tm;
	/* unsigned long ul_rslt; replaced with curr_time by Nemytykh 20.04.2022 */
	
	_ftime (& tm);
	curr_time = (tm.millitm < tm_localtime.millitm)? tm.time - tm_localtime.time - 1: tm.time - tm_localtime.time;
	sprintf (cu_refTime, "%lu.%03u", curr_time, 
		(tm.millitm < tm_localtime.millitm)? 1000 + tm.millitm - tm_localtime.millitm: tm.millitm - tm_localtime.millitm);
	
	/*cp_time = ctime (& (tm.time));*/
	/*sprintf (cu_refTime, "%.19s.%hu %s", cp_time, tm.millitm, cp_time + 20);*/
#endif

#ifdef FOR_OS_LINUX
/* 777 Nemytykh, 20.04.2022 */
   curr_time = time (NULL); /* get the current time */
   sprintf (cu_refTime, "%lu.%03u", curr_time-ltelaps,0);
#endif
    	
	check_freeze;

	if ((b1 = b1 -> foll) != b2) {
		if (!LINK_NUMBER (b1) || is_not_empty(b1,b2)) {
                        return ri_imp ();
		}
		if (b1 -> pair.n == 0) {
#ifdef FOR_OS_WINDOWSNT
			tm_localtime = tm;
#endif
#ifdef FOR_OS_LINUX
			ltelaps = curr_time;
#endif
		}
	}
/* #endif */

	rdy (0);

	for (i = 0; cu_refTime [i] != '\0'; i ++) {
		ns (cu_refTime [i]);
	}

	out (2);
	est;
	return 0;
}
  
int rf_XMLParse (void) {
  char cu_file [FILENAME_MAX];
  int i;
  FILE * fp_in, * fp_out;

  for (i = 0, b1 = b1 -> foll; b1 != b2; b1 = b1 -> foll, i ++) {
    if (! LINK_CHAR (b1)) {
      ri_error (8);
      return 1;
    }
    cu_file [i] = b1 -> pair.c;
  }
  cu_file [i] = 0;
  if (NULL == (fp_in = fopen (cu_file, "r"))) {
    fprintf (stderr, "Cannot open file \'%s\'.\n", cu_file);
    exit (1);
  }
  if (NULL == (fp_out = fopen ("REFAL5XML", "w"))) {
    fprintf (stderr, "Cannot open file \'REFAL5XML\'\n");
    exit (1);
  } 
  if (0 != ri_xml2ref (fp_in, fp_out)) {
    weld (b, rend);
    ri_error (8);
    fclose (fp_in);
    return 1;
  }
  fclose (fp_out);
  if (NULL == (fp_out = fopen ("REFAL5XML", "r"))) {
    fprintf (stderr, "Cannot open file \'REFAL5XML\'.\n");
    exit (1);
  }
  fclose (fp_in);
  return getXML (fp_out);
}

#define ESC 27


