/* Version 26-06-2025 */
# include "decl.h"
# include "macros.h"
# include "fileio.h"
# include "freeze.h"
# include "ifunc.h"


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

	/* number of characters on screen. */
/* Was: # define LINELEN  79 , Nemytykh 20-03-2023 */
# define LINELEN  159

#define EXTRN_OUT(fd) (!((fd == stderr) || (fd == stdout)))
#define EXTRN_INP(fd) (!((fd == stderr) || (fd == stdout)))

static int padding;
static char string [LINELEN+1];
static int line_length;
static int state_chars = 0;
// static int fmode_table[FILE_LIMIT];
// int fmode_table[FILE_LIMIT][2];

/* PUTMB puts the expression between the pointers Q1 and Q2 onto file *fd.	*/
/* It returns the number of printed links. */
int ri_putmb (LINK * q1, LINK * q2, FILE * fd) {
	int i;

	i = 0;
	line_length = 0;
	padding = 0;

	/* empty expression. */
	if (q1 == NULL) {
		fputc('\n',fd);
		return 0; 
	}
	
	if ((q2 == NULL) || (q1 == q2)) { /* a symbol.  */
		q1 = ri_addsym(q1,fd);
		putstr (fd, 0, NULL);
		return 1;
	}

	while (q1 != q2) {
		q1 = ri_addsym(q1,fd);
		q1 = q1 -> foll;
		i ++;
		if (LINK_LSTRUCTB (q1) && q1 -> prec == NULL && q1 -> pair.b == NULL) {
			fprintf(fd,"\nEnter free memory.\n");
			return -1;
		}
	}

	q2 = ri_addsym (q2,fd);
	if (state_chars) {
		/* Need to put '*/
		ri_add_char ('\'', fd);
		state_chars = 0;
	}
	i++;
	while (line_length) putstr (fd, 0, NULL);
	fputc ('\n', fd);
	return i;
}

/*
 It seems the function below does not need to take care of escape secuences of the form '\uhhhhhh,
 since the inversion output function never produces them.
 Is the above correct? It is still not clear.
 Nemytykh, 28-03-2023 
*/
void correctEscapeSymbols (char * cp) {
	char ca_w [MAXWS + 7];
	int i, i_len = (int)strlen (cp);

	for (i = 0; i < i_len; i ++) {
		if (cp [i] == ESCAPE || cp [i] == '\'' || cp [i] == '"' || 	cp [i] == '\n' || cp [i] == '\r' || cp [i] == '\t' ||
			cp [i] == ' ' || cp [i] == '(' || cp [i] == ')' || cp [i] == '<' || cp [i] == '>') {
			strncpy (ca_w, cp, i);
			ca_w [i] = ESCAPE;
			ca_w [i + 2] = '\0';
			ca_w [i + 3] = '\0';
			if (cp [i] == '\n') {
				ca_w [i + 1] = 'n';
			} else if (cp [i] == '\r') {
				ca_w [i + 1] = 'r';
			} else if (cp [i] == '\t') {
				ca_w [i + 1] = 't';
			} else if (cp [i] == ESCAPE || cp [i] == '\'' ||  cp [i] == '"' || 
						  cp [i] == ' ' || cp [i] == '(' || cp [i] == ')' || cp [i] == '<' || cp [i] == '>') {
				ca_w [i + 1] = cp [i];
			}
			strcpy (cp, strcat (ca_w, cp + i + 1));
//			i_len = (int)strlen (cp);
			i ++;
		} else if (cp [i] < ' ' || cp [i] > 127) {
             /* Nemytykh, 21-03-2023 */
         if  ( r_isunicode( cp + i ) ) {
         	int j = r_get_utf_ln();
         	strncpy (ca_w, cp + i, j);
            i += (j-1);
         } else {
			  strncpy (ca_w, cp, i);
                        char zero [2];
 			  ca_w [i] = '\0';

/*+ The padding for heximal represantation does not work. 
			  sprintf (ca_w + i, "%cx%0x%s", ESCAPE, cp [i], cp + i + 1);
*/
			  zero[0] = (cp [i] < 16) ? '0':'\0';
                        zero[1] = '\0';
			  sprintf (ca_w + i, "%cx%s%x%s", ESCAPE, zero, cp [i], cp + i + 1);

			  strcpy (cp, ca_w);
//			  i_len = (int)strlen (cp);
			  i += 3;
	    	};
		}
	   i_len = (int)strlen (cp);
	}
}


// Temporary definition:
# ifdef BY_GCC_MINGW_WIN
#   define ILLEG_REF_LU "Illegal pointer. %llx\n"
#   define REF_LEVEL_LU "%c%c~%llu.%llu.%llu "
# else 
#   define ILLEG_REF_LU "Illegal pointer. %lx\n"
#   define REF_LEVEL_LU "%c%c~%lu.%lu.%lu "
# endif 


LINK * ri_addsym (LINK * ptr, FILE *fd) {
	char tbuf [MAXWS + 3], esc_buf [3];
	char c, var_type;
	unsigned REFLONG u;
/*	int l;*/
/* Nemytykh, 09-06-2026: 
         Later everywhere in the Refal-5 sources the variables index, level, elev
         should be redeclared as int and even maybe as char.
         Это очень старая ошибка Саши Конышева!
*/
// Temporary definition:
	unsigned REFLONG /*variable,*/ index, level, elev; 

	if (ptr == NULL) {
		return NULL;
	}
	esc_buf [0] = ESCAPE;
	esc_buf [2] = '\0';
	switch (ptr -> ptype) {

	case LINK_TYPE_LSTRUCTB: /*** Left par. ***/
		if (state_chars) {
			ri_add_char ('\'', fd);
			ri_add_char (' ', fd);
			state_chars = 0;
		}
		ri_add_char ('(',fd);
		break; 

	case LINK_TYPE_RSTRUCTB: /*** right par. ***/
		if (state_chars) {
			ri_add_char ('\'', fd);
			ri_add_char (' ', fd);
			state_chars = 0;
		}
		ri_add_char (')',fd);
		break; 

	case LINK_TYPE_MSYMBOL: /*** (Unicode -utf8) Mcharacter. Nemytykh after Teriukha ***/
		
		u = ptr -> pair.u;
		if (state_chars == 0) {
			ri_add_char ('\'', fd);
			state_chars = 1;
		}

		char msymbol[5] = "";
		int Octet = 0;
		for (int i=3; i>=0; i--){
			if ((u & (255<<i*8)) != 0){
				msymbol[Octet] = ((u & (255<<i*8))>>i*8);
				Octet++;
			}
		}
		ri_add_string (1, msymbol, (int) strlen (msymbol), fd);
		break; 
		
	case LINK_TYPE_CHAR: /*** character. ***/
		c = ptr -> pair.c;
		if (state_chars == 0) {
			ri_add_char ('\'', fd);
			state_chars = 1;
		}

		switch (c) {
		case ESCAPE: case '(': case ')': case '<': case '>': case ' ':
		case '\'': case '"': case '\r':	case '\n': case '\t':
			esc_buf [1] = (c == '\n')? 'n': ((c == '\r')? 'r': ((c == '\t')? 't': c));
			ri_add_string (1, esc_buf, 2, fd);
			break;
				
		default:
			if (c >= ' ' && c <= 127) {
				ri_add_char (c,fd);
			} else {
				char ca_w [10];
            char zero [2];
				
/*+ The padding for heximal represantation does not work. 
				sprintf (ca_w, "%cx%0x", ESCAPE, (char) c);*/
				zero[0] = (c < 16) ? '0':'\0';
                                zero[1] = '\0';
                                sprintf (ca_w, "%cx%s%x", ESCAPE,zero,(char) c);
				ri_add_string (1, ca_w, (int) strlen (ca_w), fd);
			}
			break;
		}
		break;
		
	case LINK_TYPE_COMPSYM: /*** compound symbol. ***/
// Was:		if (isIdentifier (ptr -> pair.f)) {
		if (isPreWord (ptr -> pair.f)) {
			sprintf (tbuf, "%s ", ptr -> pair.f);
		} else {
			char ca_w [MAXWS + 3];

			strcpy (ca_w, ptr -> pair.f);
			correctEscapeSymbols (ca_w);
			sprintf (tbuf, "\"%s\" ", ca_w);
		}
		if (state_chars) {
			ri_add_char ('\'', fd);
			ri_add_char (' ', fd);
			state_chars = 0;
		}
		/*l = strlen (tbuf);*/
		ri_add_string (1, tbuf, (int) strlen (tbuf), fd);
		break;

	case LINK_TYPE_NUMBER: /*** macrodigit. ***/
		// Was sprintf (tbuf, "%lu ", ptr -> pair.n);
		sprintf (tbuf, REF_LU_SP, ptr -> pair.n); // Nemytykh 77777
		if (state_chars) {
			ri_add_char ('\'', fd);
			ri_add_char (' ', fd);
			state_chars = 0;
		}
		/*l = strlen (tbuf);*/
		ri_add_string (1, tbuf, (int) strlen (tbuf), fd);
		break;

	case LINK_TYPE_LACT: /*** Left Active Bracket.  ***/
		if (state_chars) {
			ri_add_char ('\'', fd);
			ri_add_char (' ', fd);
			state_chars = 0;
		}
		{
			char * cp_w = ptr -> pair.f - 1;
			for (cp_w --; * cp_w != '\0'; cp_w --);
			cp_w ++;
			sprintf (tbuf, "<%s ", cp_w);
		}
		/*l = strlen (tbuf);*/
		ri_add_string (2, tbuf, (int) strlen (tbuf), fd);
		break;

	case LINK_TYPE_RACT: /*** Right active Bracket. ***/
		if (state_chars) {
			ri_add_char ('\'', fd);
			state_chars = 0;
		}
		ri_add_char ('>',fd);
		break;

	case LINK_TYPE_MLSTRUCTB: 
        /* meta-variable encoded as a meta-bracket 
          [s.type '.' s.name-macrodigit '.' (e.expr) e.level] 
          e.level ::= -*
          at present e.expr ::= e.elevation, but must be "any" expressison.
          e.elevation := '1'*
        */

      type_of_metavar(var_type,ptr);
		index = index_of_metavar(ptr);
		level = (unsigned REFLONG)level_of_metavar(ptr);
		elev = (unsigned REFLONG)elevation_of_metavar(ptr);

// Nemytykh: 09-06-2026 , 77777
// Both versions below are temporary and later should be redeclared!!
//Was:		sprintf(tbuf, "%c%c~%lu.%lu.%lu ",
		sprintf(tbuf, REF_LEVEL_LU,
			ESCAPE, var_type, level, elev, index);
		ri_add_string (0, tbuf, (int) strlen (tbuf), fd);
		ptr = PAIR(ptr);
		break;

/*
	case LINK_TYPE_SVAR: / *** S-variable. **-/
	case LINK_TYPE_EVAR: / *** E-variable. **-/
	case LINK_TYPE_TVAR: / *** T-variable. **-/
		if (state_chars) {
			ri_add_char ('\'', fd);
			ri_add_char (' ', fd);
			state_chars = 0;
		}
		if (LINK_SVAR(ptr)) var_type = 'S';
		else if (LINK_EVAR(ptr)) var_type = 'E';
		else var_type = 'T';

		variable = ptr -> pair.n;
		index = index_of(variable);
		level = level_of(variable);
		elev = elevation_of(variable);
		if (elev == MAX_VAR_ELEV) sprintf(tbuf, "%c%c.%lu%c%lu ",
			ESCAPE, var_type, level, ESCAPE, index);
		else sprintf(tbuf, "%c%c.%lu%c%lu%c%lu ",
			ESCAPE, var_type, level, ESCAPE, index, ESCAPE, elev);
		/ *l = strlen (tbuf);*-/
		ri_add_string (0, tbuf, strlen (tbuf), fd);
		break;
*/

	default:			/**** Error ****/
//Was:		fprintf(fd, "Illegal pointer. %lx\n", (unsigned REFLONG) ptr); 
		fprintf(fd, ILLEG_REF_LU, (unsigned REFLONG) ptr); // lx --> llx, Nemytykh, 7777
		break; 
	}
	return ptr;
}
			
int ri_add_char (char c, FILE * fd) {
	if (line_length + padding >= LINELEN-1) putstr (fd, 0, NULL);
	string [line_length++] = c;
	return 0;
}

/* Unused?!!, Nemytykh 02-09-2023
int ri_add_msymbol (REFLONG s, FILE * fd) {
	if (line_length + padding >= LINELEN-1) putstr (fd, 0, NULL);
	string [line_length++] = s;
	return 0;
}
*/

int ri_add_string (int shared, char * tbuf, int l, FILE * fd) {
	while (line_length + padding >= LINELEN - l) {
		if (1 == putstr (fd, shared, tbuf)) {
			return 0;
		}
	}
	strcpy (string+line_length, tbuf);
	line_length += l;																				   
	return 0;
}

static int even_escapes(int);

static int even_escapes (int i) {
	/*register*/ int j = 1;

	while (--i >= 0) 
		if (string [i] == ESCAPE) j = !j;
		else break;
	return  j;
}

int putstr (FILE * fd, int flag_shared, char * tbuf) {
	/*register*/ int i;
	int paren = 0;
	char c;

	/*** Search for the 1st unbalanced right parentheses ***/
	string [line_length] = '\0';
	for (i = 0; i < line_length; i ++) 
	   if ((unsigned char) string [i] > 127) { /* Nemytykh, 14-08-2023 */
         if  ( r_isunicode( string + i ) ) { 
         	int j = r_get_utf_ln();
            i += (j-1);
            break;
         }
	   }
		switch (string [i]) {
		case ESCAPE:
			if (string [i + 1] == '<' || string [i + 1] == '>' || string [i + 1] == '(' || string [i + 1] == ')' ||
				 string [i + 1] == '\'' || string [i + 1] == '"' || string [i + 1] == ESCAPE ||
				 string [i + 1] == ' ' ||  /* Nemytykh, 14-08-2023 */
				 string [i + 1] == 'n'  || string [i + 1] == 't' || string [i + 1] == 'r') {
				i ++;
			}
			break;

		case '(':
		case '<':
			paren ++;
			break;

		case ')':
		case '>':
			paren --;
			if (paren < 0) {
				c = string [i];
				padding --;
				rc_print_buff(i, fd);
				fputc (c, fd);
				strcpy (string, string+i+1);
				line_length -= i+1;

				/* Shura added */
				if (line_length == 0) {
					if (flag_shared) {
						if (strlen (tbuf) + padding >= LINELEN) {
							fputs (tbuf, fd);
							if (flag_shared == 2) {
								int i;

								fputc ('\n', fd);
								padding ++;
								for (i = 0; i < padding; i ++) fputc (' ', fd);
							}
						}
						return 1;
					}
				}
				return 0;
			} 
			break;

		default:
			break;
		}

	/* All parentheses are paired. */
	if (paren == 0)	{
		rc_print_buff(line_length, fd);
		line_length = 0;

		/* Shura added */
		if (flag_shared) {
			if (strlen (tbuf) + padding >= LINELEN) {
				fputs (tbuf, fd);
				if (flag_shared == 2) {
					int i;

					fputc ('\n', fd);
					padding ++;
					for (i = 0; i < padding; i ++) fputc (' ', fd);
				}
				return 1;
			}
			return 0;
		}
		return 0;
	}

	/*** There are unbalanced left parentheses. ***/
	/**** Find the first one. *****/
	for (i = line_length-1; i >= 0; i --)
		switch (string [i])	{
		case ')':
		case '>':
			if (even_escapes (i)) paren ++;
			else i --;
			break;
		case '(':
		case '<':
			if (even_escapes (i)) {
				paren --;
				if (paren == 0)	{
					c = string [i];
					rc_print_buff(i, fd);
					padding ++;
					fputc (c, fd);
					strcpy (string, string+i+1);
					line_length -= i+1;

					/* Shura added */
					if (line_length == 0) {
						if (flag_shared) {
							if (strlen (tbuf) + padding >= LINELEN) {
								fputs (tbuf, fd);
								if (flag_shared == 2) {
									int i;

									fputc ('\n', fd);
									padding ++;
									for (i = 0; i < padding; i ++) fputc (' ', fd);
								}
								return 1;
							}
							return 0;
						}
					}
					return 0;
				}
			} else i --;
			break;
		default:
			break;
		}
	return 0;
}

int rc_print_buff (i, fd)
	int i;
	FILE *fd;
	{
		string [i] = '\0';
		fputs (string, fd);
		fputc ('\n', fd);
		for (i = 0; i < padding; i ++) fputc(' ', fd);
		return 0;
	}

/* determines the length of the compound symbol. */
int ri_cs_len (char *pc) {
	/*register int i;*/
	return (int) strlen (pc);
	/*
	i = strlen (pc);
	return min (i, MAXWS);
	*/
}

/* determines the length of the segment after the last new_line character of the compound symbol. */
int ri_cs_rest_len (char *pc) {
	register int i = 0;
        while( *pc ) {
           if( (*pc == '\n') || (*pc == '\r') ) i = 0;
           else i++;
           pc++; 
        }
	return i;
}

int ri_new_line (char ch) {
     if( (ch == '\n') || (ch == '\r') ) return 1;
     else return 0;
}

/* RI_PUT prints the refal expression onto file pointed by FD. */
/*	B1 has to point to the link preceding the expression. */
/*	B2 has to point to the link following the expression. */
// int ri_put (FILE * fd) {
int ri_put (FILE * fd, char mode) {
	int i_w/*, i_chars = 0*/;
	char buf [MAXWS], c /*, c_w*/;
	
	for (b1 = b1 -> foll; b1 != b2; b1 = b1 -> foll) {
		switch (b1 -> ptype) {
		case LINK_TYPE_LSTRUCTB:  /*  left parenthesis   */
/* Nemytykh 27.09.2022, 18.02.2004, see many sources on padding, done in 2004, 
   in the previous versions of this module. They were removed in 2022.
*/
         if( EXTRN_OUT(fd) ) {
           	if (IS_ENC_UTF_16(mode)) {
           		ri_putc_enc('(',fd, mode); /* An external encoding. */
           		break;
           	};
         }
			putc('(',fd);
			break;

		case LINK_TYPE_RSTRUCTB:  /*  right parenthesis   */
         if( EXTRN_OUT(fd) ) {
           	if (IS_ENC_UTF_16(mode)) {
           		ri_putc_enc(')',fd, mode); /* An external encoding. */
           		break;
           	};
         }
			putc(')',fd);
			break;

		case LINK_TYPE_CHAR:  /* object symbol */
		   c = (b1 -> pair.c);
			if( ((fd == stderr) || (fd == stdout)) && ((c & 128) != 0) ) { /* non-ascii byte */
			      /* In order to overcome treating this byte as a part of an utf-8 sequence,
			         we encode once again the byte.  */ 
				   char * enc_seq = ri_byte_to_utf_seq( (unsigned char)c ); /* Internal utf-8 encoding. */
               ri_putc ( enc_seq,c,fd );
               break;
         } /*else*/ if( IS_ENC_UTF_16(mode) ) {
               ri_putc_enc ((utf)c, fd, mode);  /* An external encoding. */
               break;   	
         } else if( ((mode == ENC_FLAT) || (mode == ENC_BINARY)) && 
                    ( ('\xC0' <= c) && (c <= '\xC3') && /* The pair is utf-8 Latin-1. A single-byte symbol encoded. */
                      (NEXT(b1) != b2) && LINK_CHAR(NEXT(b1)) && (((NEXT(b1) -> pair.c)>>6) == '\x02') ) ) {
                          b1 = NEXT(b1);
                          c = c<<6 | ((b1 -> pair.c) & '\x3F');
                          fprintf(stderr,"\n Binary_char_output: c = %x = %c\n",c,c);
/* Nemytykh: этот рудимент нужно выкинуть. Случай не реализуем. *.                        
                          goto put; // 9999, ???? 27-08-2025
                                                        /+* Latin-1 ::= Basic Latin-1 + Latin-1 Supplement */
         } // else put: putc (c, fd); // 9999, ???? 27-08-2025
		   putc (c, fd);	// 9999, ???? 27-08-2025	   
			break;

		case LINK_TYPE_COMPSYM: /*  compound symbol    */
         {
            if( EXTRN_OUT(fd) ) {
            	if (IS_ENC_UTF_16(mode)) {
            		ri_fputs_compsym_enc (b1 -> pair.f, fd, mode);  /* An external encoding. */
            		break;
            	};
            };
	   		ri_actput (b1 -> pair.f, fd);
	   		putc (' ', fd);
			};
/* ------------------------------------------------------------------------------- */
			break;

		case LINK_TYPE_NUMBER: /* macrodigit   */
//Was:			sprintf (buf,"%lu ",b1 -> pair.n); 
			sprintf (buf,REF_LU_SP,b1 -> pair.n); // Nemytykh, 04-06-2025 */
			i_w = (int) strlen (buf);
         if( EXTRN_OUT(fd) ) {
            if( IS_ENC_UTF_16(mode) ) {
                ri_fputs_ascii_enc (buf, fd, mode);  /* An external encoding. */
                break;
            }; 
         };
         fputs (buf, fd);
			break;

		case LINK_TYPE_LACT: /*  active left bracket    */
			{  // tracing and debuggind work only in internal ut8-encoding 
				char * cp;

				for (i_w = 0, cp = b1 -> pair.f - 2; 0 != * cp; cp --, i_w ++);
				cp ++;

				putc('<',fd);
				ri_actput (cp, fd);
			}

         {
				putc (' ', fd);
			};
			break;

		case LINK_TYPE_RACT:  /*  right active bracket   */
			putc('>',fd); // tracing and debuggind work only in internal ut8-encoding
			break;

		case LINK_TYPE_MSYMBOL: /* Nemytykh after Teriukha, 2022 */
		 {
   		char msymbol[5] = "";
			
			int Octet = 0;
			for ( int i=3; i>=0; i-- ) {
				if ((b1 -> pair.u & (255<<i*8)) != 0) {
					msymbol[Octet] = ((b1 -> pair.u & (255<<i*8))>>i*8);
					Octet++;
				}
			}
			/* i_w = (int) strlen(msymbol);  /+* Nemytykh after Terukha, 22.09.2022, incorrect output of utf-symbols. */
			c = msymbol[0];
			Octet--;
			if( ((mode == ENC_FLAT) || (mode == ENC_BINARY)) &&      // (fd == stdout) /* && (fd != stderr) ??? */
                    ( ('\xC0' <= c) && (c <= '\xC3') &&           // * The pair is utf-8 Latin-1. A single-byte symbol encoded. * /
                      ((msymbol[1]>>6) == '\x02') ) ) {
//--?                          c = c<<6 | ((* (msymbol+1)) & '\x3F');  // * Decoding the single-byte > 127. * /
// Может быть более читабельный вариант: но визуальное отображение обоих вариантов зависят от локали
//                                  Ð = 0xD0 (Latin 1) = Р 0xD0 (KOI8-RU) (полнобайтовой ASCII кодировке)
//                                  Видимо, позже нужно удалить эту опцию вывода ENC_FLAT и этот случай в исходном тексте ri_put
//              Утверждение выше неверно: этот случай используется при бинарном выводе!!! (crefal)
                          unsigned int ic = (unsigned char)c;                // * Decoding the single-byte > 127. * /
                          ic = (msymbol[0]<<6)+(msymbol[1] & 0x3F);
                          
                          c = (unsigned char)ic;
                          putc(c,fd);
                          break;
                                                        // * Latin-1 ::= Basic Latin-1 + Latin-1 Supplement * /
//         }
         } if( EXTRN_OUT(fd) && IS_ENC_UTF_16(mode) ) {
               ri_putc_enc (b1 -> pair.u, fd, mode);  /* An external encoding. */
               break;
			}
			fputs (msymbol, fd);
			break;
		 }

		}
	}
	return 0;
}

/* � */
/* static unsigned char q_sign[4] = {'\xEF', '\xBF', '\xBD', '\0'}; */
/* ⯑ */
static unsigned char q_sign[4] = {'\xE2', '\xAF', '\x91', '\0'};
	
void ri_putc (char * utf, char ch ,FILE * fd) {
		    /* Imitating an unpritable utf-symbol. */
   if( ((outUnprn == NO) || (fd == stderr)) 
	    && ((('\x00' <= ch) && (ch <= '\x1F')) || (('\x80' <= ch) && (ch <= '\x9F'))) ) utf = q_sign;
	fputs(utf,fd);  
}

/*	PUT_LINK prints the link pointed by PTR to the file
	pointed by FD. COL is the number of the column 
	where it starts. PUT_LINK returns the number 
	of the column where it ends.     */
/*	If the line does not fit into LINELEN columns, PUT_LINK
	automatically inserts an end of line and prints on
	the next line.		*/
/*	July 28, 1985.	D.T.	*/
/*
int ri_put_link (FILE * fd, LINK * ptr, int col) {
	register int i;
	char buf [MAXWS];
	unsigned REFLONG k;

	switch (ptr -> ptype) {
	case LINK_TYPE_LSTRUCTB:  / *  left parenthesis   * /
		if (fd == stderr || fd == stdout) {
			if (col >= LINELEN) {
				putc('\n',fd);
				col = 0;
			}
		}
		putc('(',fd);
		return col+1; / * was col++; AnK 15.06.1999 * /

	case LINK_TYPE_RSTRUCTB:  / *  right parenthesis   * /
		if (fd == stderr || fd == stdout) {
			if (col >= LINELEN) {
				putc('\n',fd);
				col = 0;
			}
		}
		putc(')',fd);
		return col+1; / * was col++; AnK 15.06.1999 * /

	case LINK_TYPE_CHAR:  / * object symbol * /
		if ( fd == stderr || fd == stdout ) {
                	if (col >= LINELEN ) { 
				putc('\n',fd);
				col = 0;
			}
		}
		if (ptr -> pait.c == '\\') {
			putc ('\\', fd);
		} else if (ptr -> pair.c == '\'') {

			putc(ptr -> pair.c, fd);
		}
		return col+1; / * was col++; AnK 15.06.1999 * /

	case LINK_TYPE_COMPSYM: / *  compound symbol    * /
        	i = ri_cs_rest_len(ptr -> pair.f); 
		if (fd == stderr || fd == stdout) {
			if (col + i > LINELEN) {/ * was >=, AnK 15.06.1999 * /
				putc('\n',fd);
				col = 0;
			}
		}
		/ *ri_actput((ptr -> pair.f) + MAXWS,fd);* /
		ri_actput (ptr -> pair.f, fd);
		if (fd == stderr || fd == stdout) {
			if (col + i < LINELEN) / * condition addded, AnK 15.06.1999 * /
				putc(' ',fd);
		} else {
			putc (' ', fd); / * Add. Shura.* /
		}
		return col+1+i;

	case LINK_TYPE_NUMBER: / * macrodigit   * /
		k = ptr -> pair.n;
		sprintf (buf,"%lu",k); / * was with blank: "%lu ", AnK 15.06.1999 * /
		i = strlen (buf);
		if (fd == stderr || fd == stdout) {
			if (col + i > LINELEN) {/ * was >=, AnK 15.06.1999 * /
				putc('\n',fd);
				col = 0;
			}
		}
		fputs (buf, fd);
		if (fd == stderr || fd == stdout) {
			if (col + i < LINELEN) / * instead of blank in format, AnK 15.06.1999 * /
    			putc(' ',fd);
		} else {
			putc (' ', fd);
		}
		return col+i+1; / * +1 was extra with blank in format, AnK 15.06.1999 * /

	case LINK_TYPE_LACT: / *  active left bracket    * /
		i = ri_cs_len(ptr -> pair.f);
		if (fd == stderr || fd == stdout) {
			if (col+1+i >= LINELEN) {
				putc('\n',fd);
				col = 0;
			}
		}
		putc('<',fd);
		/ *ri_actput(ptr -> pair.f,fd);* /
		{
			char * cp = ptr -> pair.f - 1;

			for (cp --; '\0' != * cp; cp --);
			cp ++;
			ri_actput (cp, fd);
		}

		putc(' ',fd);
		return col+2+i;

	case LINK_TYPE_RACT:  / *  right active bracket   * /
		if (fd == stderr || fd == stdout) {
			if (col >= LINELEN) {
				putc('\n',fd);
				col = 0;
			}
		}
		putc('>',fd);
		return col+1; / * was col++; AnK 15.06.1999 * /

	}
	return col;
}
*/

/* Was: # define REFINP_BUF_SIZE 256, This value is temoraly used for testing reason. Later it should be commented while the following one used! */
 # define REFINP_BUF_SIZE 256
/* Do not reduce the size below, since too many bytes may put on a line by means of unicode characters. , Nemytykh, 18-03-2023 */
/* # define REFINP_BUF_SIZE 1024*2 */
 # define MAX_REF_UNICODE_SIZE 4

// static int tmp = 0; // This line is useful for debugging.
/*	RI_GET is used by functions GET, CARD and Explode_Ext.	*/
// 777 здесь тоже нужно проверять и менять cr_flag: get_cr_flag !!!!
// Actually, the last input argument fdescr added on 28-06-2025 allows us compute the stream address fp,
// but we decide to save the first argument, in order to keep the history trace.
// See the function ri_open below for additional comments. 
int ri_get (FILE * fp, char mode, int fdescr) {
	register int i /*, ln*/;
	int flag, lim = REFINP_BUF_SIZE - MAX_REF_UNICODE_SIZE - 2, lnusymb = 0;
	int lim_back = lim;
	char line [REFINP_BUF_SIZE];

	rdy(0);
	if( EXTRN_INP(fp) && IS_ENC_UTF_16(mode) ) 
	{
	    ri_get_utf16 (fp, mode, fdescr);  // Nemytykh, 7777, 08-06-2025
	    goto end;
	};

	flag = 1;
	for (i = 1; i < (MAX_REF_UNICODE_SIZE+2); i++) line [REFINP_BUF_SIZE-i] = '\0'; //???
	if( (fp == stdin) && (mode == ENC_UNKNOWN) ) mode = ENC_NONFLAT;

	while (flag) {
		/* test for end-of-file. */
		if (fgets (line, lim, fp) == NULL) {
			nns(0);
			break;
		} else {
//			for (i = 0; (i < lim) && (flag != 0); i ++, lim = lim_back) {
			for (i = 0; i < lim; i ++, lim = lim_back) {

				if (line [i] == '\n') { flag = 0; }
				else if (line [i] == '\0') { break; }
				else if(mode == ENC_FLAT) 
				     {  // Was: ns (line [i]); 
				        if( (unsigned char)(line [i]) > 127 ) {
    		             utf symb = r_int_to_utf((unsigned char)(line [i]));
    		             mns (symb);
    	              } else 
    	              { ns (line [i]); } 
				     }
				else {   /* ENC_NONFLAT - синоним utf8 */
                     if ( ((i+MAX_REF_UNICODE_SIZE+1) > lim) && ((line [i] & 0xC0) == 0xC0) ) {
				        	if ( ((line [i] & 0xF8) == 0xF0) ) { lnusymb = 4; }
				        	else if ( ((line [i] & 0xF0) == 0xE0) ) { lnusymb = 3; }
// Was				        	else if ( ((line [i] & 0xE0) == 0xC0) ) { lnusymb = 2; }
				        	else if ( ((line [i] & 0xE0) == 0xC0) && (line [i] >= 0xC2)) { lnusymb = 2; } // utf-8 кодировок < 0xC2 не существует!!!, Немытых 15-09-2023
				        	else { lnusymb = 1; }
				        	
                             /* the last byte is a header of an utf-8 symbol: try to read its body */
				        		     /* Is there no need to test for non-existing the body, i.e. does fgets return NULL? */
				        		     
//		                  if ( lnusymb > 1 ) fgets (((char *)line)+(i+1), lnusymb, fp);  /*  Nemytykh, 12-12-2023 */
  		                  if ( lnusymb > 1 ) { /* A proper prefix of a unicode symbol occupies the end of the line buffer */
  		                                       /* Its proper suffix should be read on the buffer end and the buffer size has to be increased. Nemytykh, 12-18-2023 */
  		                       lim--; 
  		                       char * post_dist = ((char *)line)+lim;
  		                       int post_ln = (i+1+lnusymb) - lim;
                  		     fgets (post_dist, post_ln, fp); 
                  		     lim = i+MAX_REF_UNICODE_SIZE+1;  /*  Nemytykh, 12-18-2023 */
                  		     // tmp = 1; // This line is useful for debugging.
  		                  	} 
  		                                    // ㇰ = E3 87 B0 ; 𪜀 = F0 AA 9C 80 -- are useful for debugging.
				        }
                  i += ri_getc (((char *)line)+i,mode);
				     }
			}
   		if ( i >= REFINP_BUF_SIZE ) ri_error(16); /*  Nemytykh, 18-03-2023 */
//?			if ( i > lim ) ri_error(16); /*  Nemytykh, 18-03-2023 */
		}
	}
	/* Long commented old sources were removed here. Nemytykh, 28.09.2022 */
 end:
	out(2);
	est;
	return 0;
}

int ri_getc (char * cp_w, char mode) {
	register int ln;
	
	utf symb = r_isunicode(cp_w);
	if (symb) {	
		mns (symb);
      ln = r_get_utf_ln();
/*	} else {     // Was, Nemytykh, 14-09-2023
		ns (* cp_w);
		ln = 1;
	}
*/
  } else if ( ( (unsigned char)(* cp_w)) > 127 ) {   // Nemytykh, 14-09-2023
		symb = r_int_to_utf((unsigned char)(* cp_w));
		mns (symb);
		ln = 1;
  } else 
  {   ns (* cp_w); ln = 1; } 

	return (ln-1);
}


// Nemytykh, 26-06-2025, 7777
/* Opens the file with name REFAL#.DAT, where # is LOGNUM (the parameter), with mode MODE. */
int ri_open (int lognum, char * mode, char * name) {
	int enc = ENC_NONFLAT; /* Default encoding mode name. */
	char mode1[32];
	char mch = 0, lowch;
	char * m = (char *)mode1;
	int i = 0;

   for( ; i < 32; i++ ) {
     mode1[i] = *(mode+i);
     if ( (mode1[i] == '\0') || (mode1[i] == ',') ) break; 
   }
	/* Close the file if it was opened under this logical number. */
	if (NULL != file_table [lognum]) fclose(file_table [lognum]);
	
	/* Looking for encoding mode name. */
	while ( (*m != 0) && (*m != ',')) {
/*		if( ((*m == 'r') || (*m == 'R') || (*m == 'a') || (*m == 'A') || (*m == 'w') || (*m == 'W')) && !mch ) // 7777
		   mch = tolower (*m);
*/
      lowch = tolower(*m);
		if( ((lowch == 'r') || (lowch == 'a') || (lowch == 'w') ) && !mch ) 
		   mch = lowch;
		m++;
	}
//Was:	if( (*m == ',') && (strncmp("ccs=", m+1, 4) == 0) ) enc = ri_get_enc(m+5);
	if( *m == ',' ) {
	   if( strncmp("ccs=", mode+i+1, 4) == 0 ) {
   		enc = ri_get_enc(mode+i+5);
         *m = '\0'; /* Do not transfer the encoding method name to fopen below. */
	   }
	} else {
		enc = ENC_UTF_8;
      *m = '\0'; /* Do not transfer the encoding method name to fopen below. */
	};
   if	( ENC_UNKNOWN == enc ) {
   	fprintf(stderr,"Unkown encoding \"%s\" given when trying to open %s.\n",mode,name);
   	goto err;
   }

	fmode_table [lognum][0] = mch;
	fmode_table [lognum][1] = ((tolower(*(mode++)) == 'w') && (tolower(*(mode)) == 'b')) ? ENC_BINARY : enc;  // 7777, Nemytykh, 26-06-2025
	fmode_table [lognum][2] = EMPTY_MARKER; // there exists no ungot char in the stream. 7777, Nemytykh, 28-06-2025
	       /* In oder to treat any pair CR-NL as the only NL, while CR-notNL also as NL,
	       and taking in acount that the Refal input/output unit is a line rather than a character (or unicode-symbol),
	       we are sometimes forced to read the first symbol of the next line that is not still an object to be read
	       by the given active call of the Get built-in function. As a consiquence, we have to keep the next-line read symbol
	       in fmode_table [lognum][2]. The following call of the Get function reading the same stream should take the kept symbol
	       as the first symbol of the line to be read.
	       EOF signals that no symbol kept by the previous call of the get function.   
	       */

	/* Open the new file. */
//	file_table [lognum] = fopen(name,mode1);
//	file_table [lognum] = r_wfopen(name,mode1, fmode_table [lognum][1]);
	file_table [lognum] = ri_wfopen(name,mode1, fmode_table [lognum][1]);
	if (file_table [lognum]  == NULL) {
		fprintf(stderr,"can\'t open %s.\n",name);
		err:
		    fmode_table [lognum][1] = ENC_UNKNOWN; 
		    ri_error(2);
 	}

	return 0;
}

int ri_get_enc(char * encode) {
// It seems the following line is incorrect.
//	if( ((strncmp("Flat", encode, 4) == 0)) || ((strncmp("ascii", encode, 5) == 0)) ) return ENC_FLAT;

	if( ((strncmp("Flat", encode, 4) == 0))  || ((strncmp("latin-1", encode, 7) == 0)) ) return ENC_FLAT;
   if( ((strncmp("Nonflat", encode, 7) == 0)) ) return ENC_UTF_8;
	
   if( ((strncmp("utf", encode, 3) == 0)) ) {
      encode += 3;
      if( ((strncmp("-8", encode, 2) == 0)) || (* encode == '8') ) 
           return ENC_UTF_8;
   	if( ((strncmp("16be", encode, 4) == 0)) || (strncmp("-16be", encode, 5) == 0) ) 
   	     return ENC_UTF_16BE;
   	if( ((strncmp("-16", encode, 3) == 0)) || ((strncmp("16", encode, 2) == 0)) || ((strncmp("-16le", encode, 5) == 0)) ) 
   	       return ENC_UTF_16LE;
   }
	return ENC_UNKNOWN;
}

void ri_init_std_streems(void) {
	outUnprn = YES; /* output unprintable chars by themselves */
	std_streem_fmodes[R_STDERR] = ENC_NONFLAT; /* stderr */
	std_streem_fmodes[R_STDIN]  = ENC_NONFLAT;  /* stdin  */
	std_streem_fmodes[R_STDOUT] = ENC_NONFLAT; /* stdout */
	std_streem_fmodes[R_STDAUX] = ENC_NONFLAT; /* stdaux, std port  */
	std_streem_fmodes[R_STDPRN] = ENC_NONFLAT; /* stdprn, std printer  */
}

/* ACTPUT prints the compound symbol pointed by F to the file 
 * with pointer FD. It returns the length of the string.
 */
/*	July 28, 1985.	D.T. */
int ri_actput (char *f, FILE *fd) {
	return (fputs (f, fd));
}

