Context Navigation

cifm3.c

Revision 1, 129.6 kB (checked in by heitor.barbieri, 3 years ago)
Criação do svn para Cisis.

Line
1	/* file CIFM3.C */
2	#define RETIRAR 1 /* Usado para colocar em rotina alocacao de var char */
3	#include <stdio.h>
4	#include <ctype.h>
5	#include <string.h>
6	#include <time.h>
7	#if TESTFREE
8	#include <conio.h>
9	#endif
10
11	#include "cisis.h"
12	#include "cifmt.h"
13
14	#ifndef FUNPROCX
15	#define FUNPROCX 0
16	#endif
17
18	#if CICPP
19	#include "cicgi.hpp"
20	#include "cifmt.hpp"
21	#endif /* CICPP */
22
23	#define DEBUG_REF 0
24	#define MICRO_ISIS_COMPATIBLE 0
25
26	#if !CICPP /* otherwise DINALLOC is #defined in cifmt.hpp */
27	#define DINALLOC 1 /* p/ alocar areas originalmente estaticas - AOT 29/12/90 */
28	#endif /* CICPP */
29
30	#define TRACE_REPLACE 0
31	#define TRACE_STRFUN 0
32	#define TRACE_REPF 0
33	#define TRACE_INTER_X 0 /* printf instruction in execution */
34	#define TRACE_INTER_L 0 /* printf debug in lookup() */
35	#define TRACE_INTER_2 0 /* printf Apos fmt_load_all_occ */
36	#define DEB_FLOAT 0
37	#define TRACE_COMP_M 00 /* printf msg in trata_md() */
38
39	#if FATRAP
40	#define IFERR_GOTO
41	#define IFERR_RET
42	#else
43	#define IFERR_GOTO if (fmterror) goto ERROR_LABEL
44	#define IFERR_RET if (fmterror) return
45	#endif /* FATRAP */
46
47	/* Modificacoes:
48	A05 - 19/07/96
49	Problema:
50	A funcao REF nao esta liberando corretamente as prateleiras onde sao
51	lidos os registros do MasterFile, quando um Ref e' utilizado dentro
52	de outro Ref.
53	Exemplo: REF(val(ref(1,'3'),...)
54	Se aplicarmos esse REF para varios registros, dara erro FATAL de
55	alocacao.
56	Identificacao:
57	Sempre que um novo REF e encontrado em um formato, e gurdado no
58	vetor "vprats" apontado por "currprat" o numero da prateleira
59	disponivel de 255 ..0.
60	Quando termina o REF, a prateleira vprats[currprat] devera ser
61	liberada.
62	O problema acontecia porque "currprat" estava apontando para a proxima
63	entrada disponivel de "vprats" e nao para a ultima usada. No momento
64	de liberar os apontadores estavam defasados. A rotina de leitura do
65	master era feita numa prateleira(rec_prateleira) que nao estava
66	alocada forcando a alocacao. Esse registro nao era liberado.
67	Correcao:
68	Corridos os apontadores. Para compatibilizacao, a prateleira de
69	entrada do formato e' guardada na primeira posicao de vprats para
70	sinalizar o registro em uso.
71	Foram inseridos alguns traces para achar o erro.
72	*/
73
74
75
76	/--------------------------------------------------------------------------/
77	/* E e S variaveis */
78	/--------------------------------------------------------------------------/
79	#if !CICPP
80	static float_x E_var[NMAXVAR];
81	static char *S_var[NMAXVAR];
82	#endif /* CICPP */
83
84
85	/--------------------------------------------------------------------------/
86	/* NewLine */
87	/--------------------------------------------------------------------------/
88	/* A07*/
89	#if !CICPP
90	char nl_STR; / Armazena o string para tratar caracteres de newline */
91	int nl_LEN;
92	int nl_ALLOC;
93	#endif /* CICPP */
94
95	/-----------------------------------------------------------------------/
96	#define ispunctuation(x) \
97	((x==';'\|\|x=='.' \|\| x==':' \|\| x== ',' \|\| x=='!'\|\| x=='?' )?true:false )
98	/-----------------------------------------------------------------------/
99	#define NO_INTERVAL(x) (x ? ((x->lower==NO_MIN_OCC) && (x->upper==NO_MAX_OCC)) : false)
100	/-----------------------------------------------------------------------/
101
102	/* error - AOT 29/12/90 */
103	/* #define MAXERRL 60 */
104
105	#if !CICPP
106	#if FATRAP
107	jmp_buf fmtjumper;
108	#endif /* FATRAP */
109	char fmterrxy[MAXERRL+1] = { "" } ;
110	int fmterror;
111	/A06/
112	ALLOPARM literal_len;
113	char *literal;
114	/A06/
115	#if ANSI
116	/float_x convert_to_float(stack_node top); */
117	int fmt_type_pattern(char patt,char fmt);
118	int fmt_type_number(int tipo,char *fmt);
119	void fmt_init_E_S(void);
120	void free_S(int from,int to);
121	char fmt_copy_realloc(char dest,ALLOPARM dest_mxlen,char cte_str);
122	char fmt_alloc_char(ALLOPARM tam,char msg);
123	int fmt_instr(char str_source,char str_sub);
124	char fmt_type(char p);
125	void trace_field(field_definition_node i,char p); /* AOT 27/12/91 */
126	LONGX number_of_lines(char *p);
127	static void sub_field_string(char *q, char sub);
128	/* char long_to_char(LONGX valor, int n); substituida/
129	char trata_md( instruction_code mode , char s,int final_added,char *p);
130	void upcase_mode(char *s);
131	void out_put_str(char out[],LONGX maxsize,int *pout,LONGX lw,
132	int id1,int id2,LONGX *ncc,char s[]);
133	#else
134
135	float_x convert_to_float();
136	int fmt_type_pattern();
137	int fmt_type_number();
138
139	void fmt_init_E_S();
140	void free_S();
141
142	char *fmt_copy_realloc();
143	char *fmt_alloc_char();
144	int fmt_instr();
145	char *fmt_type();
146	void trace_field(); /* AOT 27/12/91 */
147	LONGX number_of_lines();
148	static void sub_field_string();
149	/* char long_to_char(); substituida /
150	char *trata_md();
151	void upcase_mode();
152	void out_put_str();
153	#endif
154	#endif /* CICPP */
155
156	/--------------------------------------------------------------------------/
157	/* global types */
158	/--------------------------------------------------------------------------/
159	#if !CICPP
160	typedef union stack_operands {
161	int i;
162	float_x r;
163	int boolean;
164	char *s;
165	char *address;
166	LONGX l;
167	#if CICPP /ifcmm/
168	RECSTRU *lrecp;
169	#endif /CICPP/ /endcmm/
170	} ustackopnd;
171	typedef struct stack_nodex{
172	enum classe_operandos classe;
173	union stack_operands op;
174
175	}stack_node;
176
177	/* prototypes */
178	#if ANSI
179	int exec_percent(char out,int outs,LONGX *ncc);
180	void retrieve_two_numeric_operands (void);
181	stack_node *pop(void);
182	void inter_error (char *err);
183	void restore_context(void);
184	void push ( stack_node *e);
185	int cast_to_int (stack_node *e);
186	char field_value(char p,LONGX n,int dd);
187	void retrieve_determine_class(void);
188	void take_numeric_operands_value(class_operand new_class);
189	char *sub_string(char source[],int offset,int length);
190	void save_context(int modify_pointers);
191	char store_tmp_string (char str);
192	int is_numeric(class_operand x);
193	void retrieve_two_operands (void);
194	#else
195	int exec_percent();
196	void retrieve_two_numeric_operands ();
197	stack_node *pop();
198	void inter_error();
199	void restore_context();
200	void push ();
201	int cast_to_int ();
202	char *field_value();
203	void retrieve_determine_class();
204	void take_numeric_operands_value();
205	char *sub_string();
206	void save_context();
207	char *store_tmp_string ();
208	int is_numeric();
209	void retrieve_two_operands ();
210	#endif
211	#endif /* CICPP */
212
213
214	/--------------------------------------------------------------------------/
215	/* global_variables */
216	/--------------------------------------------------------------------------/
217	#if !CICPP
218
219	#define max_stack MAXSTACK
220	#define MAX_TMP_STR (MAXMFRL/2)
221	#define MAX_SFIELD (MAXMFRL/2)
222	#define MAX_FD_VALUE (MAXMFRL/2)
223	#define MAX_FD_TMP (MAXMFRL/2)
224
225	LONGX erro_fatal;
226	stack_node stack[max_stack];
227	int stack_pt;
228	stack_node op1_node,op2_node,top_node;
229	stack_node top,elem,op1,op2,auxpop;
230
231	#if DINALLOC
232	//LONGX fmt_fsiz=MAXMFRL; /* fmt_inter() - to set max field length - deslocado para cidbx.c */
233	static LONGX din_fsiz; /* fmt_inter() - current max field length */
234	static char *tmp_str;
235	static LONGX max_tmp_str;
236	static LONGX max_fd_value;
237	static LONGX max_fd_tmp;
238	#else
239	static char tmp_str[MAX_TMP_STR+1];
240	static LONGX max_tmp_str=MAX_TMP_STR;
241	static LONGX max_fd_value=MAX_FD_VALUE;
242	static LONGX max_fd_tmp=MAX_FD_TMP;
243	#endif
244
245	int tmp_str_index;
246	class_operand new_class,class_of_the_both;
247	int result;
248	int cond_code;
249	instruction_code instruction;
250	int tempint;
251	int int_value_1,int_value_2;
252
253	float_x tempfloat,float_value_1,float_value_2 ;
254	LONGX templong ,long_value_1,long_value_2;
255
256	int there_is_fd_value;
257	int there_is_suf;
258	int rep_group;
259	int next_rep_occ;
260	int modify_fmt_pointers=true;
261	int no_modify_fmt_pointers=false;
262
263	#define infoi(i) i->info.instr
264	#define ilab(i) i->info.lab
265	#define iadd(i) i->m_add
266	#define next_infoi(i) i->next
267
268	#define fld_def_ptr(i) i->m_add
269	#define str_const_ptr(i) i->m_add
270
271
272	/* mudar de local para global */
273	char *out;
274	LONGX lw_inter;
275	int pout;
276
277	char address_out,tmp_ptr;
278	LONGX nextcc;
279
280
281	/* incio para achar bug de ref */
282	#if DEBUG_REF
283	int iii;
284	LONGX iix;
285	#endif
286	/* fim para achar bug de ref */
287	/* getc_char */
288	#define get_char /* getchar() */
289	/* 04-02-95 Existia um problema quando havia sufixo e este era
290	colocado no fim de linha e logo apos um crlf.
291	Mesmo o n sendo zero, isto e, nao tendo sido colocado
292	um final do isis padrao pois havia sufixo, por causa
293	do crlf eram retirados 2 caracteres. O crlf so pode
294	ser levado em conta se tiverem sido acrescentados
295	caracteres no final (n>0)
296	*/
297
298	#endif /* CICPP */
299
300	#define delete_chars(out,pout,next,n,lw) \
301	if(n>0) \
302	{ \
303	if(fmt_CRLF(out,pout)) n=n+nl_LEN; /* mudar junto com crlf */ \
304	pout=pout-n; \
305	out[pout]=null_char; \
306	next=next-n; \
307	if(next<1) next=lw-n+1; \
308	} \
309	/--------------------------------------------------------------------------/
310	/* retrieve_two_logical_operands */
311	/--------------------------------------------------------------------------/
312	#define retrieve_two_logical_operands \
313	auxpop = pop(); \
314	if (!fmterror) \
315	{ \
316	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node)); \
317	auxpop = pop(); \
318	if (!fmterror) \
319	{ \
320	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node)); \
321	if (op1->classe!=op2->classe \|\| op1->classe != logical) \
322	inter_error(" Program error two logical operands expected"); \
323	else \
324	elem.classe=logical; \
325	} \
326	}
327
328
329	/----------------------------------------------------- AOT 27/12/91 -------/
330	/--------------------------------------------------------------------------/
331	/* sc */
332	/* Conversao de strings do tipo "\n" em caracter especial "lf" */
333	/--------------------------------------------------------------------------/
334
335	#if !CICPP
336
337	struct tbc {
338	char s_esp[3];
339	int c_esp;
340	/* } tb_espec[]={"\\r",'R',"\\t",'T',"\\b",'B',"\\n",'N',"\\0",'0'};*/
341	#if BEFORE20000518
342	} tb_espec[]={"\\r",'\r',"\\t",'\t',"\\b",'\b',"\\n",'\n',"\\0",'\0'};
343	#else
344	#if BEFORE20000914
345	} tb_espec[]={{"\\r",'\r'},{"\\t",'\t'},{"\\b",'\b'},{"\\n",'\n'},{"\\0",'\0'}};
346	#else
347	} tb_espec[]={{"\\\r",'\r'},{"\\\t",'\t'},{"\\\b",'\b'},{"\\\n",'\n'},{"\\\0",'\0'}};
348	#endif
349	#endif
350
351	#endif /* CICPP */
352
353
354	#if CICPP
355	void FMTSTRU :: sc(char *pp)
356	#else /* CICPP */
357	#if ANSI
358	void sc(char *pp)
359	#else /* ANSI */
360	void sc(pp)
361	char *pp;
362	#endif /* ANSI */
363	#endif /* CICPP */
364	{
365	char tmp,p,*r;
366	int k;
367	ALLOPARM cte_siz;
368	cte_siz=(ALLOPARM) strlen((char *)pp);
369	tmp=fmt_alloc_char( (ALLOPARM)(cte_siz+1),"cifm2/sc/alloc");
370	/* if (tmp == NULL) IFERR_GOTO; Label ERROR_LABEL is defined at fmt_inter */
371	if (tmp == NULL) fatal("cifm2/sc/alloc/2");
372	strcpy(tmp,pp);
373	p=pp;
374	r=tmp;
375	for (; *tmp ;p++,tmp++) {
376	if (*tmp!='\\') {
377	p=tmp;
378	}else{
379	for (k=0; tb_espec[k].c_esp;k++){
380	#if BEFORE20000914
381	if (strncmp(tb_espec[k].s_esp,(char *)tmp,2)==0) {
382	#else
383	if (strncmp(tb_espec[k].s_esp,(char *)tmp,strlen(tb_espec[k].s_esp))==0) {
384	#endif
385	*p=(char)tb_espec[k].c_esp;
386	tmp++;
387	#if 01
388	#ifndef CICPP
389	printf("\n++ achou\|%s\|", tb_espec[k].s_esp);
390	#endif /* CICPP */
391	#endif
392	break;
393	}
394	}
395	}
396	}
397	*p=null_char;
398	#if 0
399	printf ("\nDentro sc=\|%s\|",q);
400	printf ("\nDentro tmp=\|%s\|",tmp);
401	#endif
402	#if CICPP
403	delete [] r;
404	#else
405	FREE(r);
406	#endif
407
408	}
409
410	/--------------------------------------------------------------------------/
411	/* trace_field */
412	/--------------------------------------------------------------------------/
413	#if CICPP
414	void FMTSTRU :: trace_field(field_definition_node *i,
415	char *p)
416	#else /* CICPP */
417	#if ANSI
418	void trace_field(field_definition_node *i,
419	char *p)
420	#else /ANSI/
421	void trace_field(i,p)
422	field_definition_node *i;
423	char *p;
424	#endif /ANSI/
425	#endif /* CICPP */
426	{
427	int n=0;
428	printf(
429	"#%d[tag=%d,subf=%c,id1=%d,id2=%d,off=%d,len=%d,max=%d,last=%d\n=%s,\n",
430	n,
431	i->tag,
432	i->sub_field,
433	i->indent1,
434	i->indent2,
435	i->offset,
436	i->length,
437	i->max_occ,
438	i->last_occ,p);
439	printf(
440	"act=%d,first=%d\n",
441	i->actual_occ,
442	i->first_occ);
443	}
444
445	/--------------------------------------------------------------------------/
446	/* fmt_type_number */
447	/--------------------------------------------------------------------------/
448	/* type(tipo,formato)
449	tipo =1 alphanumeric
450	tipo =2 alphabetic
451	tipo =3 numeric
452	tipo =4 inteiro decimal. Opcional sinal
453	tipo =5 numero decimal incluindo scientific
454
455	*/
456	#if CICPP
457	int FMTSTRU :: fmt_type_number(int tipo,
458	char *fmt)
459	#else /* CICPP */
460	#if ANSI
461	int fmt_type_number(int tipo,char *fmt)
462	#else
463	int fmt_type_number(tipo,fmt)
464	int tipo;
465	char *fmt;
466	#endif /ANSI/
467	#endif /* CICPP */
468	{ char p,pt_num;
469	int res,a,n,len,scien;
470	res= 0;
471	p=fmt;
472	len=strlen(p);
473	if (len==0) return(1); /* Vazio retorna sempre 1 */
474
475	switch (tipo) {
476	case 1 :
477	case 2 :
478	case 3 :
479	a=0;n=0;
480	while (*p) {
481	if (isiswctab[*p]) a++;
482	if (isdigit(*p)) n++;
483	p++;
484	}
485	if (tipo == 1 && a+n == len) res=1 ;
486	else if (tipo == 2 && a == len) res=1;
487	else if (tipo == 3 && n == len) res=1;
488
489	break;
490	case 4 :
491	case 5 :
492	a=0;
493	scien=0;
494	n=0; /* supor numero inteiro */
495	pt_num=find_numeric_string(p,&a);
496	if ( (strchr(pt_num,'e') != nulo) \|\|
497	(strchr(pt_num,'E') !=nulo ) ) scien=1;
498	if (strchr(pt_num,'.') !=nulo) n=1;
499
500	p=fmt;
501	a=1;
502	while (a) { /* Micro isis aceita espacos `a esqueda */
503	if (p != space_char \|\| p == null_char )a=0;
504	else p++ ;
505	}
506	if ((size_t)strlen(pt_num)==(size_t)strlen(p)){
507	if (tipo==4 && scien == 0 && n==0 ) res=1;
508	else if (tipo == 5) res=1;
509	}
510	break;
511
512	}
513	return(res);
514	}
515	/--------------------------------------------------------------------------/
516	/* fmt_type_pattern */
517	/--------------------------------------------------------------------------/
518	/* Compara um string com um padrao do tipo
519	patt=xx-xx-99-xx-aa
520	str =ca-dd-11-1a-bb
521	Se tamanhos s~ao difentes, entao resultado falso
522	Senao compara caracter a caracter
523	*/
524	#if CICPP
525	int FMTSTRU :: fmt_type_pattern(char *patt,
526	char *fmt)
527	#else /* CICPP */
528	#if ANSI
529	int fmt_type_pattern(char patt,char fmt)
530	#else
531	int fmt_type_pattern(patt,fmt)
532	char *patt;
533	char *fmt;
534	#endif /ANSI/
535	#endif /* CICPP */
536	{ char p,q;
537	int res,l;
538	p=patt; q=fmt; res=1;
539	l=strlen(patt);
540	if (l != strlen(fmt)) return(0);
541	while(res && *p ) {
542	switch ( toupper(*p)) {
543	case 'A' :
544	res = isiswctab[*q];
545	break;
546	case 'X' :
547	res = 1;
548	break;
549	case '9' :
550	if ( !isdigit(*q)) res=0;
551	break;
552	default :
553	res = (q == p);
554	}
555	p++;q++;
556	}
557	return (res);
558
559	}
560	/----------------------------------------------------- AOT 27/12/91 -------/
561	/--------------------------------------------------------------------------/
562	/* fmt_type */
563	/--------------------------------------------------------------------------/
564	/* Usa rotina que separa dentro de um string o proximo numero
565	Se o tamanho do numero separado e igual ao tamanho do string e'porque
566	o string e numerico.
567	Caso contrario verifica se contem apenas letras para ser
568	alfabetico.
569	Caso contrario e alfanumerico
570	*/
571	#if CICPP
572	char * FMTSTRU :: fmt_type(char *p)
573	#else /* CICPP */
574	#if ANSI
575	char fmt_type(char p)
576	#else /ANSI/
577	char *fmt_type(p)
578	char *p;
579	#endif /ANSI/
580	#endif /* CICPP */
581	{
582	static char tmp_ty[2];
583	int i;
584	char q,pt_num;
585	q=p;
586	tmp_ty[1]=null_char;
587	tmp_ty[0]=TY_X;
588	i=0;
589	pt_num=find_numeric_string(p,&i);
590	if ((size_t)strlen(pt_num)==(size_t)strlen(p)){
591	tmp_ty[0]=TY_N;
592	}else{
593	while (isiswctab[q] \|\| q==' ') q++;
594	if (*q==null_char)tmp_ty[0]=TY_A;
595	}
596	/03-11-99 Alterar para retornar '' quando string vazio /
597	if ( (size_t)strlen(p) == (size_t)0 ) tmp_ty[0]=null_char;
598	return (char *)tmp_ty;
599	}
600	/--------------------------------------------------------------------------/
601	/* fmt_init_E_S */
602	/--------------------------------------------------------------------------/
603	#if CICPP
604	void FMTSTRU :: fmt_init_E_S(void)
605	#else /* CICPP */
606	#if ANSI
607	void fmt_init_E_S()
608	#else /ANSI/
609	void fmt_init_E_S()
610	#endif
611	#endif /* CICPP */
612	{ int i;
613	for (i=0;i<NMAXVAR;i++) {
614	E_var[i]= (float_x) 0;
615	S_var[i]= NULL;
616	}
617	}
618	/--------------------------------------------------------------------------/
619	/* fmt_free_S */
620	/--------------------------------------------------------------------------/
621	#if CICPP
622	void FMTSTRU :: fmt_free_S(int from,
623	int to)
624	#else /* CICPP */
625	#if ANSI
626	void fmt_free_S(int from, int to)
627	#else /ANSI/
628	void fmt_free_S(from ,to)
629	int from, to;
630	#endif
631	#endif /* CICPP */
632	{ int i;
633
634	for (i=from;i<=to;i++) {
635
636	if (S_var[i] != NULL)
637	#if 0
638	printf("Lib=[%p]\n", S_var[i]);
639	#endif
640	#if CICPP
641	delete [] (char *)S_var[i];
642	#else /* CICPP */
643	FREE(S_var[i]);
644	#endif /* CICPP */
645	S_var[i]=NULL;
646	}
647	}
648
649
650	/--------------------------------------------------------------------------/
651	/* fmt_copy_realloc */
652	/--------------------------------------------------------------------------/
653	#if CICPP
654	char * FMTSTRU :: fmt_copy_realloc(char *pdest,
655	ALLOPARM *dest_mxlen,
656	char *cte_str)
657	#else /* CICPP */
658	#if ANSI
659	char fmt_copy_realloc(char pdest,ALLOPARM dest_mxlen,char cte_str)
660	#else /ANSI/
661	char *fmt_copy_realloc(pdest,dest_mxlen,cte_str)
662	/Armazena cte_str em pdest /
663	char pdest; /Se necessario realloca pdest para*/
664	ALLOPARM dest_mxlen; /que str_cte caiba e muda tamanho */
665	char cte_str; / max do pdest.Retorna novo endereco*/
666	#endif /ANSI/
667	#endif /* CICPP */
668	{
669	char *p;
670	ALLOPARM cte_siz;
671	cte_siz=(ALLOPARM) strlen((char *)cte_str);
672	if (dest_mxlen<cte_siz){ / realloca string */
673	p=fmt_alloc_char( (ALLOPARM)(cte_siz+1),"cifm3/fmt_realloc");
674	/* if (p == NULL) IFERR_GOTO; Label ERROR_LABEL is defined at fmt_inter */
675	if (p == NULL) fatal("cifm3/fmt_realloc/2");
676	strcpy(p,cte_str);
677	#if CICPP
678	delete [] pdest;
679	#else
680	FREE(pdest);
681	#endif
682
683	*dest_mxlen=cte_siz;
684	return p;
685	}else { /* copia apenas cte_str */
686	strcpy(pdest,cte_str);
687	return pdest; /para efeito de compatibilizar /
688	}
689	}
690	/--------------------------------------------------------------------------/
691	/* fmt_alloc_char */
692	/--------------------------------------------------------------------------/
693
694	#if CICPP
695	char * FMTSTRU :: fmt_alloc_char(ALLOPARM tam,
696	char *msg)
697	#else /* CICPP */
698	#if ANSI
699	char fmt_alloc_char(ALLOPARM tam,char msg)
700	#else /ANSI/
701	char *fmt_alloc_char(tam,msg)
702	ALLOPARM tam;
703	char *msg;
704	#endif /ANSI/
705	#endif /* CICPP */
706	{
707	char *t;
708	#if CICPP
709	try
710	{ t=(char *)new char [(tam)]; }
711	catch (BAD_ALLOC)
712	{ t=(char *)ALLONULL; }
713	#else /* CICPP */
714	t=(char *)ALLOC((ALLOPARM)(tam));
715	#endif /* CICPP */
716	if (t == (char *)ALLONULL) {inter_error(msg); return NULL; }
717	return t;
718	}
719
720
721	/--------------------------------------------------------------------------/
722	/* fmt_instr */
723	/--------------------------------------------------------------------------/
724	#if CICPP
725	int FMTSTRU :: fmt_instr(char *str_source,
726	char *str_sub)
727	#else /* CICPP */
728	#if ANSI
729	int fmt_instr(char str_source,char str_sub)
730	#else /ANSI/
731	int fmt_instr(str_source,str_sub)
732	char str_source,str_sub;
733	#endif /ANSI/
734	#endif /* CICPP */
735	{
736	char p,res;
737	int pos;
738	pos=0;
739	res=NULL;
740	p=str_source;
741	res = strstr(p,str_sub);
742	if (res!=NULL && p!=NULL && str_sub!=NULL ) {
743	if (res && str_sub) {
744	int ll;
745	ll=strlen(str_sub);
746	pos=1;
747	while (memcmp(p,str_sub,ll)!=0) {
748	p++; pos++;
749	}
750	}
751	}
752	return pos;
753	}
754	/--------------------------------------------------------------------------/
755	/* retrieve_two_numeric_operands */
756	/--------------------------------------------------------------------------/
757	#if CICPP
758	void FMTSTRU :: take_numeric_operands_value(class_operand new_class)
759	#else /* CICPP */
760	#if ANSI
761	void take_numeric_operands_value(class_operand new_class)
762	#else /ANSI/
763	void take_numeric_operands_value(new_class)
764	class_operand new_class;
765	#endif /ANSI/
766	#endif /* CICPP */
767	{
768	int_value_1=0;
769	int_value_2=0;
770	long_value_1=0L;
771	long_value_2=0L;
772	float_value_1=0.0;
773	float_value_2=0.0;
774
775
776	switch(new_class)
777	{ case integer :
778	int_value_1=op1->op.i;
779	int_value_2=op2->op.i;
780	break;
781	case long_n :
782	if(op1->classe==integer) long_value_1=(LONGX) op1->op.i;
783	if(op1->classe==long_n) long_value_1=op1->op.l;
784	if(op2->classe==integer) long_value_2=(LONGX) op2->op.i;
785	if(op2->classe==long_n) long_value_2=op2->op.l;
786	break;
787	case float_n :
788	if(op1->classe==integer) float_value_1=(float) op1->op.i;
789	if(op1->classe==long_n) float_value_1=(float) op1->op.l;
790	if(op1->classe==float_n) float_value_1=op1->op.r;
791	if(op2->classe==integer) float_value_2=(float) op2->op.i;
792	if(op2->classe==long_n) float_value_2=(float) op2->op.l;
793	if(op2->classe==float_n) float_value_2=op2->op.r;
794
795	break;
796
797	}
798	}
799
800	#if CICPP
801	void FMTSTRU :: retrieve_determine_class(void)
802	#else /* CICPP */
803	void retrieve_determine_class()
804	#endif /* CICPP */
805	{
806	auxpop = pop(); IFERR_RET;
807	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
808	auxpop = pop(); IFERR_RET;
809	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
810	if (op1->classe==string && op2->classe==string){new_class=string;}
811	else
812	{ if ( (op1->classe==integer\|\|op1->classe==float_n \|\|
813	op1->classe==long_n
814	) &&
815	(op2->classe==integer \|\| op2->classe==float_n \|\| op2->classe==long_n) )
816	{if (op1->classe == op2->classe)
817	{ new_class=op1->classe ; }
818	else {if (( op1->classe == integer \|\| op1->classe == long_n ) &&
819	(op2->classe == integer \|\| op2->classe == long_n)
820	) new_class=long_n ;
821	else new_class=float_n;
822	}
823	}
824	else
825	{
826	inter_error("Invalid class of operands for aritmetic/string operators");
827	return;
828	}
829	}
830	}
831
832	/-----------------------------------------------------------------------/
833	#if CICPP
834	void FMTSTRU :: retrieve_two_numeric_operands (void)
835	#else /* CICPP */
836	void retrieve_two_numeric_operands ()
837	#endif /* CICPP */
838	{
839	retrieve_determine_class();
840	IFERR_RET;
841	if(new_class==string)
842	{
843	inter_error("Invalid class of operands for aritmetic operators");
844	return;
845	}
846	else take_numeric_operands_value(new_class);
847
848	} /* precedure */
849	/--------------------------------------------------------------------------/
850	/* retrieve_two_operands */
851	/--------------------------------------------------------------------------/
852	#if CICPP
853	void FMTSTRU :: retrieve_two_operands(void)
854	#else /* CICPP */
855	void retrieve_two_operands()
856	#endif /* CICPP */
857	{
858	retrieve_determine_class();
859	IFERR_RET;
860	class_of_the_both=new_class;
861	if (new_class!=string) take_numeric_operands_value(new_class);
862
863	}
864
865
866	/-------------------------------------------------------------------------/
867	/* is_not_of_class */
868	/-------------------------------------------------------------------------/
869	#define is_not_of_class(x,cl) \
870	if(x!=cl) inter_error("Invalid operand class "); \
871
872
873	/--------------------------------------------------------------------------/
874	/* is_numeric */
875	/--------------------------------------------------------------------------/
876
877	#if CICPP
878	int FMTSTRU :: is_numeric(class_operand x)
879	#else /* CICPP */
880	#if ANSI
881	int is_numeric(class_operand x)
882	#else /ANSI/
883	int is_numeric(x)
884	class_operand x;
885	#endif /ANSI/
886	#endif /* CICPP */
887	{
888	if ( !( x==integer \|\| x==float_n \|\| x==long_n) )
889	{ inter_error("Aritmetic operand expected "); }
890	return(1);
891	}
892
893
894	/--------------------------------------------------------------------------/
895	/* convert_to_float */
896	/--------------------------------------------------------------------------/
897	#if CICPP
898	float_x FMTSTRU :: convert_to_float(stack_node *top)
899	#else /* CICPP */
900	#if ANSI
901	float_x convert_to_float(stack_node *top)
902	#else /ANSI/
903	float_x convert_to_float(top)
904	stack_node *top;
905	#endif /ANSI/
906	#endif /* CICPP */
907	{ float_x x;
908	is_numeric(top->classe);
909	if (top->classe == integer) x = (float_x) top->op.i;
910	if (top->classe == float_n) x = (float_x) top->op.r;
911	if (top->classe == long_n) x = (float_x) top->op.l;
912	return (x);
913	}
914
915
916
917	/------------------------------------------------------------------------/
918	/* save_context */
919	/------------------------------------------------------------------------/
920
921	#if CICPP
922	void FMTSTRU :: save_context(int modify_pointers)
923	#else /* CICPP */
924	#if ANSI
925	void save_context(int modify_pointers)
926	#else /ANSI/
927	void save_context(modify_pointers)
928	int modify_pointers;
929	#endif /ANSI/
930	#endif /* CICPP */
931	{
932
933	#if DEB_FLOAT
934	printf("\n++Save_context l_w=%ld nextcc=%ld pout=%d \nout=%s\|",
935	lw_inter,nextcc,pout,out);
936	#endif
937	elem.classe=next_cc;
938	elem.op.l=nextcc;
939	push(&elem);
940	IFERR_RET;
941
942	elem.classe=xindex;
943	elem.op.i=pout;
944	push(&elem);
945	IFERR_RET;
946
947	elem.classe=l_w;
948	elem.op.l=lw_inter;
949	push(&elem);
950	IFERR_RET;
951
952	elem.classe=ptr;
953	elem.op.address= &out[0];
954	push(&elem);
955	IFERR_RET;
956
957	/* define new context */
958
959	out= &out[pout];
960	pout=0;
961	#if TRACESINDO
962	address_out=out;
963	#endif
964	/* These pointers must not be modified for the REF function */
965	if (modify_pointers==true)
966	{
967	lw_inter= MAXMFRL; /* no limits/ / aot - svd 8000L */
968	nextcc=1;
969	}
970
971	}
972
973	/--------------------------------------------------------------------------/
974	/* restore_context */
975	/--------------------------------------------------------------------------/
976
977	#if CICPP
978	void FMTSTRU :: restore_context(void)
979	#else /* CICPP */
980	void restore_context()
981	#endif /* CICPP */
982	{
983	#if DEB_FLOAT
984	int i;
985	#endif
986	tmp_ptr= &out[0]; /save old string /
987
988	/restore the context /
989	auxpop = pop(); IFERR_RET;
990	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
991	is_not_of_class(top->classe,ptr);
992	IFERR_RET;
993	out=top->op.address;
994	address_out=out;
995
996	auxpop = pop(); IFERR_RET;
997	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
998	is_not_of_class(top->classe,l_w);
999	IFERR_RET;
1000	lw_inter=top->op.l;
1001
1002	auxpop = pop(); IFERR_RET;
1003	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
1004	is_not_of_class(top->classe,xindex);
1005	if (fmt_error) return;
1006	pout=top->op.i;
1007
1008	auxpop = pop(); IFERR_RET;
1009	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
1010	is_not_of_class(top->classe,next_cc);
1011	IFERR_RET;
1012	nextcc=top->op.l;
1013	#if DEB_FLOAT
1014	printf("\n++Rest_ctext l_w=%ld nextcc=%ld pout=%d \nout=%s\|\n",
1015	lw_inter,nextcc,pout,out);
1016
1017	if (pout>5) {
1018	for (i=pout-5;i<=pout;i++)printf("%c",out[i]);
1019	printf("*");
1020	}
1021	#endif
1022
1023	}
1024
1025	/--------------------------------------------------------------------------/
1026	/* sub_string */
1027	/--------------------------------------------------------------------------/
1028	#if CICPP
1029	char * FMTSTRU :: sub_string(char source[],
1030	int offset,
1031	int length)
1032	#else /* CICPP */
1033	#if ANSI
1034	char *sub_string(char source[],
1035	int offset,
1036	int length)
1037	#else /ANSI/
1038	char *sub_string(source,offset,length)
1039	char source[];
1040	int offset;
1041	int length;
1042	#endif /ANSI/
1043	#endif /* CICPP */
1044	{
1045	int fd_len;
1046	char *q;
1047
1048	q=source;
1049
1050	fd_len=strlen(source);
1051	if(offset<0 \|\| length<0) return(q);
1052	if(offset >= fd_len) *q=null_char;
1053	else
1054	{
1055	q= &source[offset];
1056	fd_len=fd_len-offset;
1057	if(fd_len>length)q[length]=null_char;
1058	}
1059	return q;
1060	}
1061
1062	#if !CICPP
1063	static char *retorno;
1064	#endif /* CICPP */
1065
1066
1067	/--------------------------------------------------------------------------/
1068	/* store tmp_string */
1069	/--------------------------------------------------------------------------/
1070	#if CICPP
1071	char * FMTSTRU :: store_tmp_string (char *str)
1072	#else /* CICPP */
1073	#if ANSI
1074	char store_tmp_string (char str)
1075	#else /ANSI/
1076	char *store_tmp_string (str)
1077	char *str;
1078	#endif /ANSI/
1079	#endif /* CICPP */
1080	{
1081	int len;
1082
1083	if (!str) str=""; /* AOT 04/03/97 */
1084	len=strlen(str);
1085	#if DEB_FLOAT
1086	printf("\n--Storetmp str=%s\|\nlen=%d",str,len);
1087	#endif
1088	if(tmp_str_index+len > max_tmp_str)
1089	{
1090	inter_error("No room to store temporary strings - change MAX_TMP_STR");
1091	return NULL;
1092	}
1093	strcpy(&tmp_str[tmp_str_index],str);
1094	retorno= &tmp_str[tmp_str_index];
1095	tmp_str_index += len+1;
1096	return retorno;
1097	}
1098
1099
1100
1101
1102	/--------------------------------------------------------------------------/
1103	/* cast_to_int */
1104	/--------------------------------------------------------------------------/
1105	#if CICPP
1106	int FMTSTRU :: cast_to_int (stack_node *e)
1107	#else /* CICPP */
1108	#if ANSI
1109	int cast_to_int (stack_node *e)
1110	#else /ANSI/
1111	int cast_to_int (e)
1112	stack_node *e;
1113	#endif /ANSI/
1114	#endif /* CICPP */
1115	{int tmp;
1116	if (e->classe == integer) tmp=e->op.i;
1117	if (e->classe == long_n ) tmp=(int )e->op.l;
1118	if (e->classe == float_n) tmp= (int) e->op.r;
1119	return (tmp);
1120	}
1121	/--------------------------------------------------------------------------/
1122	/* push */
1123	/--------------------------------------------------------------------------/
1124	#if CICPP
1125	void FMTSTRU :: push (stack_node *e)
1126	#else /* CICPP */
1127	#if ANSI
1128	void push (stack_node *e)
1129	#else /ANSI/
1130	void push (e)
1131	stack_node *e;
1132	#endif /ANSI/
1133	#endif /* CICPP */
1134	{
1135	stack_pt++;
1136	if(stack_pt >= max_stack) /* AOT - 27/11/91 */
1137	{
1138	inter_error("Stack overflow - expression too complex ");
1139	return;
1140	}
1141	stack[stack_pt].classe=e->classe;
1142	stack[stack_pt].op=e->op;
1143	}
1144
1145	/--------------------------------------------------------------------------/
1146	/* pop */
1147	/--------------------------------------------------------------------------/
1148	#if CICPP
1149	FMTSTRU :: stack_node * FMTSTRU :: pop(void)
1150	#else /* CICPP */
1151	stack_node *pop()
1152	#endif /* CICPP */
1153	{
1154	static stack_node rr;
1155	static stack_node *prr;
1156	prr= &rr;
1157	if(stack_pt<1){inter_error("Stack underflow"); return NULL;}
1158	rr.classe=stack[stack_pt].classe;
1159	rr.op=stack[stack_pt].op;
1160	stack_pt--;
1161	return prr;
1162	}
1163
1164
1165	/--------------------------------------------------------------------------/
1166	/* exec_percent */
1167	/* Applies de % rules to the output string "out" pointed by "outs" */
1168	/* A07 - Rotina com erro: retirava todos os "newline" do fim da linha e */
1169	/* na verdade tem que deixar apenas um */
1170	/* Retorna 0 se nao ficaram caracteres de "muda-linha" */
1171	/* >0 caso contrario */
1172	/--------------------------------------------------------------------------/
1173
1174	#if CICPP
1175	int FMTSTRU :: exec_percent(char *out,
1176	int *outs,
1177	LONGX *ncc)
1178	#else /* CICPP */
1179	#if ANSI
1180	int exec_percent(char *out,
1181	int *outs,
1182	LONGX *ncc)
1183	#else /ANSI/
1184	int exec_percent(out,outs,ncc)
1185	char *out;
1186	int *outs;
1187	LONGX *ncc;
1188	#endif /ANSI/
1189	#endif /* CICPP */
1190	{
1191	int nnl,k,noend;
1192	k= *outs;
1193	noend=true;
1194	nnl=0;
1195
1196	/* Determina quantos "muda_linha existem no string" */
1197	while( noend==true && k>nl_LEN){
1198	noend=fmt_CRLF(out,k);
1199	if (noend==true){
1200	k=k-nl_LEN;
1201	nnl++;
1202	}
1203	} /while/
1204
1205	if (nnl>1) {
1206	#if MICRO_ISIS_COMPATIBLE
1207	/* Retira os nnl-1 "muda-linha" excedentes */
1208	nnl--;
1209	#endif
1210	k=outs-nnlnl_LEN;
1211	out[k]=null_char;
1212	*outs=k;
1213	*ncc=1;
1214	}
1215	return nnl;
1216	#if 0
1217	*outs=k;
1218	/* end string and modify pointer */
1219	/* calculate the lentgh of the last line to set up nextcc */
1220	nnl=1;
1221	while( !fmt_CRLF(out,k) &&k>1)
1222	{ l++;k--;}
1223	*ncc=l;
1224	#endif
1225	} /percent /
1226
1227
1228
1229	/--------------------------------------------------------------------------/
1230	/* trata_md */
1231	/--------------------------------------------------------------------------/
1232
1233	#if CICPP
1234	char * FMTSTRU :: trata_md(instruction_code mode,
1235	char *s,
1236	int *final_added,
1237	char **tofreep)
1238	#else /* CICPP */
1239	#if ANSI
1240	char *trata_md(instruction_code mode,
1241	char *s,
1242	int *final_added,
1243	char **tofreep)
1244	#else /ANSI/
1245	char *trata_md(mode,s,final_added,tofreep)
1246	instruction_code mode;
1247	char *s;
1248	int *final_added;
1249	char **tofreep;
1250	#endif /ANSI/
1251	#endif /* CICPP */
1252	{
1253	char q; / now via ALLOC() */
1254	char *pq;
1255
1256	char c;
1257	int i,j,k,fim,len;
1258	int menor;
1259
1260	*tofreep=NULL;
1261
1262	/* for mpl and mpu modes there's no change in the filling information */
1263
1264	if(mode==mpu_par \|\| mode==mpl_par)
1265	{
1266	return s;
1267	}
1268
1269	if((len=strlen(s))==0) return s;
1270	#if !RETIRAR
1271	Consultar Adalberto/Piva
1272	#if CICPP
1273	try
1274	{ q=(char *)new char [(len+3+9+1)]; }
1275	catch (BAD_ALLOC)
1276	{ q=(char *)ALLONULL; }
1277	#else /* CICPP */
1278	q=(char *)ALLOC((ALLOPARM)(len+3+9+1));
1279	#endif /* CICPP */
1280	if (q == (char *)ALLONULL) {inter_error("trata_md/ALLOC"); return NULL; }
1281	#else
1282	q=fmt_alloc_char((ALLOPARM)(len+3+9+1),"trata_md/ALLOC");
1283	#endif /RETIRAR /
1284
1285	*tofreep=q;
1286
1287	pq=q;
1288	i=0;
1289	j=0;
1290	menor=false;
1291	fim=false;
1292	*final_added=0;
1293	q[0]=null_char;
1294
1295	while (fim==false)
1296	{
1297	#if TRACE_COMP_M
1298	if( s[i]==null_char ) if (fmttrace) printf(" \n achou null no comeco mode");
1299	#endif /* TRACE_COMP_M */
1300	c= s[i];
1301
1302	/* first stores a character into the output; then verifies if the
1303	character had to be stored or must be eliminated */
1304
1305	q[j]=c;
1306	i++;
1307	j++;
1308
1309	if (c==null_char)
1310	{ /* string analisis has finished
1311	for mdu and mdl two blanks and a punctuation mark( if none)
1312	has to be added;
1313	for mhu and mhl nothing is added
1314	*/
1315
1316
1317	if(mode==mhl_par \|\| mode==mhu_par)
1318	{
1319	pq= sub_field_change(pq);
1320	return pq;
1321	}
1322	/* aplica pontuacao */
1323	fim=false;
1324	for (k=j-1;k>=0 && fim==false; k--)
1325	{if(q[k]!=' ') fim=true;}
1326	if( !ispunctuation(q[k]) )
1327	{
1328	*final_added=1;
1329	k++;
1330	q[k]='.';
1331	}
1332	k++;
1333	q[k++]=' ';
1334	q[k++]=' ';
1335	q[k]=null_char;
1336	final_added= final_added+2;
1337	pq= sub_field_change(pq);
1338	return pq;
1339	}
1340
1341	if ((c==equal_char) && (menor==true))
1342	{ /* ignores the string after "="
1343	for the constructions like <100=hundred> */
1344	while (( s[i]!=null_char) && (s[i]!=greater_char)) {
1345	i=i+1;}
1346	/* ignore all chars befor e < */
1347	if (s[i]==greater_char)
1348	{
1349	if (s[i+1]==less_char)
1350	{ q[j-1]=';' ;
1351	q[j]=' ';
1352	j++;
1353	i++;
1354	}
1355	else {
1356	menor=false;
1357	j--;
1358	}
1359	}
1360	else { /* s[i]=null_char. Retira o "=" */
1361	j--;
1362	q[j]=null_char;
1363	fim=true;
1364	fim=false; /* SVD - 25/09/94 Erro Mas Aceita */
1365	}
1366	} /c=eql_char../
1367	else { if (c==less_char)
1368	{ menor=true;
1369	j--;
1370	}
1371	else
1372	{ if (c==greater_char)
1373	{
1374	if (s[i]==less_char)
1375	{ q[j-1]=';';
1376	q[j]=' ';
1377	j++;
1378	i++;
1379	menor=true;
1380	}
1381	else {
1382	j--;
1383	}
1384	}
1385	}
1386	}
1387
1388	}
1389
1390	/* 25-09-94
1391	Esta dando erro quando um string tem no fim uma sequencia do tipo "<x=y"
1392	O MicroIsis assume um ">" e eu estava indicando erro.
1393	Para deixar como ISIS , retorna o string que foi conseguido enquanto
1394	procurava o ">".
1395	( Acho que a parte de tratamento de sequencias "..><.." pelo MicroIsis
1396	esta incoerente com a documentacao .
1397	Nao vou mexer na minha implementacao sem saber qual a implementacao correta
1398	)
1399	E importante notar que se o campo contem ">" ou "<"estes sao sempre
1400	ignorados.
1401
1402	Precisa forcar a colocar a pontuacao e tratamento de subfield.
1403	Para isso basta mudar a condicao de fim=true para fim=false quando
1404	nao achou o ">". Assim forca a repetir o loop e o proximo caracter
1405	a ser tratado e'c=null_char o que vai fazer com que execute a pontuacao
1406
1407	return("rot.c/trata_md/<100=hundred>");
1408	*/
1409
1410	return(s); /* AOT/RP - 21/10/94 (ver com Sindo) */
1411	}
1412
1413
1414	/------------------------------------------------------------------------/
1415	/* sub_field_string */
1416	/------------------------------------------------------------------------/
1417	#if CICPP
1418	void FMTSTRU :: sub_field_string(char *q,
1419	char sub)
1420	#else /* CICPP */
1421	#if ANSI
1422	static void sub_field_string(char *q,char sub)
1423	#else /ANSI/
1424	static void sub_field_string(q,sub)
1425	char *q;
1426	char sub;
1427	#endif /ANSI/
1428	#endif /* CICPP */
1429	{
1430	char ss,p;
1431	char *t,r[3];
1432	int len;
1433
1434	len=strlen(q);
1435
1436	if(len==0) return;
1437
1438	if(sub==subfield_null) return;
1439	#if !RETIRAR
1440	#if CICPP
1441	try
1442	{ ss=(char *)new char [(len+1)]; }
1443	catch (BAD_ALLOC)
1444	{ ss=(char *)ALLONULL; }
1445	#else /* CICPP */
1446	ss=(char *)ALLOC((ALLOPARM)(len+1));
1447	#endif /* CICPP */
1448	if (ss == (char *)ALLONULL) {inter_error("sub_field_string/ALLOC"); return; }
1449	#else
1450	ss=fmt_alloc_char((ALLOPARM)(len+1),"sub_field_string/ALLOC");
1451	#endif
1452	if (ss == (char *)ALLONULL) return;
1453
1454	ss[0]=null_char;
1455	r[0]=SFLDCHR;
1456	r[1]=' ';
1457	r[2]=null_char;
1458	t=q;
1459
1460	if(sub==multiply_char) /* any subfield */
1461	{
1462	if (len >=2 )
1463	{
1464	if (t==SFLDCHR) {t++; t++;} / ignores 2 char " ^char" */
1465	}
1466	/* len < 2 or not SFLDCHR => It is not a field with subfield */
1467	}
1468	else
1469	{ /* search the substring "^char" using upper and lower cases */
1470	r[1]=tolower(sub);
1471	t=strstr(q,r);
1472	if(t==nulo)
1473	{
1474	r[1]=toupper(sub);
1475	t=strstr(q,r);
1476	}
1477
1478	if(t==nulo) {
1479	q[0]=null_char;
1480	#if CICPP /ifcmm/
1481	delete [] ss;
1482	#else /elsecmm/
1483	FREE(ss);
1484	#endif /CICPP/ /endcmm/
1485	return;
1486	}
1487
1488	/* copies the substring from t to the end or until another substring delimiter */
1489	t++;
1490	t++; /* ignores the delimiters */
1491	}
1492
1493	p=ss;
1494	while ( (t!=null_char) && (t!=SFLDCHR) ) {
1495	if (t == '\\') if ((t+1) == SFLDCHR) t++;
1496	if (*t == null_char) break;
1497	p++ = t++;
1498	}
1499
1500	/* string termination */
1501	*p=null_char;
1502	strcpy(q,ss);
1503	#if CICPP
1504	delete [] (char *)ss;
1505	#else /* CICPP */
1506	FREE(ss);
1507	#endif /* CICPP */
1508	return;
1509	}
1510
1511
1512	#if !CICPP
1513
1514	/* rotinas aritmeticas */
1515	static char str_num[30],*pstr_num;
1516	static LONGX ref_mfn_number;
1517	/* end rotinas aritmeticas */
1518
1519	/* f function variables*/
1520	static int min_width;
1521	static int dec_places;
1522	/* end f-function variables */
1523
1524	#if DINALLOC
1525	static char *v_fd_value;
1526	static char *v_fd_tmp;
1527	#else
1528	static char v_fd_value[MAX_FD_VALUE+1];
1529	static char v_fd_tmp[MAX_FD_TMP+1];
1530	#endif
1531
1532	static char fd_value,fd_tmp;
1533
1534	static LONGX lineqtt; /* RPIVA/AOT/HB - 16/11/98 */
1535
1536	#endif /* CICPP */
1537
1538	/* ----------------------------- cifm3h.c --------------------------- */
1539
1540	/------------------------------------------------------------------------/
1541	/* file: cifm3h.c */
1542	/------------------------------------------------------------------------/
1543	#if !CICPP
1544
1545	#define PRT_DBNAME 0
1546	#define DEB_NOCC 0
1547	/* Continue em grupos repetitivos 17-7-94 */
1548	static int continue_rgroup_maxocc;
1549	static int continue_rgroup;
1550	static char cc;
1551	static int pos;
1552	static int fmt_fim;
1553	static int fmt_n_ref;
1554	static int must_repeat;
1555	static l_code *ni;
1556	static l_code rpni; /repf*/
1557	static float_x float_exp_value;
1558	static field_definition_node *itf;
1559	static RECSTRU *recp;
1560	#if !CICPP /if!cmm/
1561	#define MAXREFS 16
1562	static LONGX vprats[MAXREFS];
1563	static int currprat=0;
1564	static LONGX trm_prat;
1565	static LONGX irec;
1566	#endif /CICPP/ /endcmm/
1567	static char *firstdbnp;
1568
1569	#if ANSI
1570	static char *fmt_get_date(int parmdate, LONGX secs0);
1571	static float_x fmt_cnv_to_float(stack_node *top);
1572	static LONGX fmt_cnv_to_long(stack_node *top);
1573	static void fmt_init_vinstr(l_code *pins,int nnested );
1574	static int fmt_load_all_occ(void);
1575	static void fmt_load_next_occ(void);
1576	static void fmt_comum_ref_beg(void);
1577	static void fmt_comum_ref_end(void);
1578	static void fmt_inicio_grupos_vfields(instruction_code instr_inicial,
1579	instruction_code instr_final);
1580	#else
1581	static char *fmt_get_date();
1582	static float_x fmt_cnv_to_float();
1583	static LONGX fmt_cnv_to_long();
1584	static void fmt_init_vinstr();
1585	static int fmt_load_all_occ();
1586	static void fmt_load_next_occ();
1587	static void fmt_comum_ref_beg();
1588	static void fmt_comum_ref_end();
1589	static void fmt_inicio_grupos_vfields();
1590	#endif
1591
1592	#endif /* CICPP */
1593
1594	/* ------------------------field value ----------------------------- */
1595
1596	#if CICPP
1597	char * FMTSTRU :: field_value(char *sfieldvalue,
1598	LONGX max_sfield,
1599	int dd)
1600	#else /* CICPP */
1601	#if ANSI
1602	char field_value(char sfieldvalue,
1603	LONGX max_sfield,
1604	int dd)
1605	#else /ANSI/
1606	char *field_value(sfieldvalue,max_sfield,dd)
1607	char *sfieldvalue;
1608	LONGX max_sfield;
1609	int dd;
1610	#endif /ANSI/
1611	#endif /* CICPP */
1612	{
1613	int slen;
1614
1615	if (dd < 0 \|\| dd >= (int)(MFRnvf) ) {
1616	sfieldvalue[0]=null_char;
1617	if (fmttrace)
1618	printf("field_value - dd=%d tag=undefined '%s'\n",
1619	dd,sfieldvalue);
1620	return (sfieldvalue);
1621	}
1622
1623	slen=DIRlen(dd);
1624
1625	if (slen > max_sfield) {
1626	slen=max_sfield-3;
1627	memcpy(sfieldvalue,FIELDP(dd),slen);
1628	sprintf(sfieldvalue+slen,"+++");
1629	if (fmttrace) printf("%s MAX_SFIELD=%ld\n",sfieldvalue+slen,slen);
1630	}
1631	else {
1632	memcpy(sfieldvalue,FIELDP(dd),slen);
1633	sfieldvalue[slen]='\0';
1634	}
1635	if (fmttrace)
1636	printf("field_value - dd=%d tag=%u '%s'\n",
1637	dd,DIRtag(dd),sfieldvalue);
1638	return (sfieldvalue);
1639	}
1640
1641
1642	/-------------------------------------------------------------------------/
1643	/* fmt_get_date */
1644	/-------------------------------------------------------------------------/
1645	#if CICPP
1646	char * FMTSTRU :: fmt_get_date(int parmdate, LONGX secs0)
1647	#else /* CICPP */
1648	#if ANSI
1649	char *fmt_get_date(int parmdate, LONGX secs0)
1650	#else /ANSI/
1651	char *fmt_get_date(parmdate,secs0)
1652	int parmdate;
1653	LONGX secs0;
1654	#endif /ANSI/
1655	#endif /* CICPP */
1656	{
1657	static char fmt_date[21+1]; /* aaaammdd hhmmss WDAY YDAY */
1658	/* 1234567890123456 7 8 901 */
1659	LONGX secs_now;
1660	struct tm *tp;
1661	#if BEFORE20010216
1662	#else
1663	if (secs0 >= 0) {
1664	/*The allowable range of calendar times is Jan 1 1970 00:00:00 to Jan 19 2038 03:14:07.
1665	*/
1666	if (secs0 < 86400) secs0=86400; /* seconds('19700102 000000') */
1667	if (secs0 > 2147408047) secs0=2147408047; /* seconds('20380118 031407') */
1668	secs_now=secs0;
1669	} else
1670	#endif
1671	time(&secs_now);
1672	/*time gives the current time, in seconds, elapsed since 00:00:00 GMT, January 1, 1970,
1673	and stores that value in the location pointed to by timer, provided that timer is not a NULL pointer.
1674	*/
1675	tp=localtime(&secs_now);
1676	/*localtime accepts the address of a value returned by time and returns a pointer to the structure of type tm containing the time elements.
1677	It corrects for the time zone and possible daylight saving time.
1678	The global LONGX variable _timezone contains the difference in seconds between GMT and local standard time (in PST, _timezone is 8 x 60 x 60). The global variable daylight contains nonzero only if the standard U.S. daylight saving time conversion should be applied. These values are set by tzset, not by the user program directly.
1679	*/
1680	switch (parmdate) {
1681	case DATEONLY:
1682	sprintf(fmt_date,"%02d/%02d/%02d",
1683	tp->tm_mday,tp->tm_mon+1,tp->tm_year%100);
1684	break;
1685	case DATETIME:
1686	sprintf(fmt_date,"%02d/%02d/%02d %02d:%02d:%02d",
1687	tp->tm_mday,tp->tm_mon+1,tp->tm_year%100,
1688	tp->tm_hour,tp->tm_min,tp->tm_sec);
1689	break;
1690	case 1: /A11 compatibilidade com microisis /
1691	sprintf(fmt_date,"%02d-%02d-%02d %02d:%02d:%02d",
1692	tp->tm_mon+1,tp->tm_mday,tp->tm_year%100,
1693	tp->tm_hour,tp->tm_min,tp->tm_sec);
1694
1695	break;
1696	case 2:
1697	sprintf(fmt_date,"%02d-%02d-%02d",
1698	tp->tm_mon+1,tp->tm_mday,tp->tm_year%100);
1699	break;
1700	case 3:
1701	sprintf(fmt_date,"%02d:%02d:%02d",
1702	tp->tm_hour,tp->tm_min,tp->tm_sec);
1703	break;
1704	default:
1705	sprintf(fmt_date,"%04d%02d%02d %02d%02d%02d %1d %3d",
1706	1900+tp->tm_year,tp->tm_mon+1,tp->tm_mday,
1707	tp->tm_hour,tp->tm_min,tp->tm_sec,
1708	tp->tm_wday,tp->tm_yday);
1709	}
1710	return (char *)fmt_date;
1711
1712	}
1713	/-------------------------------------------------------------------------/
1714	/* fmt_cnv_to_long */
1715	/-------------------------------------------------------------------------/
1716	#if CICPP
1717	LONGX FMTSTRU :: fmt_cnv_to_long(stack_node *top)
1718	#else /* CICPP */
1719	#if ANSI
1720	LONGX fmt_cnv_to_long(stack_node *top)
1721	#else /ANSI/
1722	LONGX fmt_cnv_to_long(top)
1723	stack_node *top;
1724	#endif /ANSI/
1725	#endif /* CICPP */
1726	{ static LONGX tmp_long;
1727
1728	if (top->classe==long_n) tmp_long=top->op.l;
1729	else
1730	if (top->classe==float_n) tmp_long=(LONGX) top->op.r;
1731	else if(top->classe==integer) tmp_long =(LONGX )top->op.i;
1732	else fatal("fmt_inter/Invalid number type ");
1733	return tmp_long;
1734	}
1735	/-------------------------------------------------------------------------/
1736	/* fmt_cnv_to_float */
1737	/-------------------------------------------------------------------------/
1738	#if CICPP
1739	float_x FMTSTRU :: fmt_cnv_to_float(stack_node *top)
1740	#else /* CICPP */
1741	#if ANSI
1742	float_x fmt_cnv_to_float(stack_node *top)
1743	#else /ANSI/
1744	float_x fmt_cnv_to_float(top)
1745	stack_node *top;
1746	#endif /ANSI/
1747	#endif /* CICPP */
1748	{ static float_x tmp_float;
1749
1750	if (top->classe==long_n) tmp_float=(float_x ) (top->op.l);
1751	else
1752	if (top->classe==float_n) tmp_float=(float_x) top->op.r;
1753	else if(top->classe==integer) tmp_float=(float_x )top->op.i;
1754	else fatal("fmt_inter/Invalid number type ");
1755	return tmp_float;
1756	}
1757
1758	/-------------------------------------------------------------------------/
1759	/* fmt_init_vinstr */
1760	/-------------------------------------------------------------------------/
1761	#if CICPP
1762	void FMTSTRU :: fmt_init_vinstr(l_code *ptr_ins,
1763	int nnested)
1764	#else /* CICPP */
1765	#if ANSI
1766	void fmt_init_vinstr(l_code *ptr_ins,
1767	int nnested)
1768	#else /ANSI/
1769	void fmt_init_vinstr(ptr_ins, nnested )
1770	l_code *ptr_ins;
1771	int nnested;
1772	#endif /ANSI/
1773	#endif /* CICPP */
1774	{
1775	int tmp_occ;
1776	if ( (infoi(ptr_ins)==test_occ) \|\| (infoi(ptr_ins)==load_field_all) \|\|
1777	(infoi(ptr_ins)==absent) \|\| (infoi(ptr_ins)==load_field_occ) \|\|
1778	(infoi(ptr_ins)==present) \|\| (infoi(ptr_ins)==print_field) \|\|
1779	(infoi(ptr_ins)==noccins) )
1780	{ itf=(field_definition_node *) iadd(ptr_ins);
1781	itf->max_occ= -1;
1782	itf->actual_occ=0;
1783	itf->last_occ=0;
1784	itf->first_occ=0;
1785	/* Implementar continue dentro de groupo repetitivo 17-7-94*/
1786	if(nnested==1){
1787	#if CICPP /ifcmm/
1788	tmp_occ=recp->xnocc(itf->tag);
1789	#else /elsecmm/
1790	tmp_occ=nocc(irec,itf->tag);
1791	#endif /CICPP/ /endcmm/
1792	if (tmp_occ>continue_rgroup_maxocc)continue_rgroup_maxocc=tmp_occ;
1793	}
1794	}
1795	}
1796	/-------------------------------------------------------------------------/
1797	/* fmt_inicio_grupos_vfields */
1798	/-------------------------------------------------------------------------/
1799	/*DOC 010:
1800	No inicio de um novo grupo e' necesario guardar o contexto
1801	em que o formato esta sendo executado e inicializar essas
1802	variaveis. Esse contexto e representado pelas variaveis
1803	rep_group
1804	next_rep_occ
1805	must_repeat.
1806	Os contadores das instrucoes que referenciam Fields (Vfields)
1807	devem ser inicializados para permitir repeticao dentro
1808	de repeticao para implementar o novo conceito de fields repetitivos.
1809	O grupo de instrucoes que deve ser inicializado e' delemitado pelas
1810	variaveis (instrucao_inicial, instrucao_final).
1811	No caso de grupo repetitivo a proxima instrucao gerada vai incializar
1812	as variaveis do contexto.
1813	*/
1814	#if CICPP
1815	void FMTSTRU :: fmt_inicio_grupos_vfields(instruction_code instr_inicial,
1816	instruction_code instr_final)
1817	#else /* CICPP */
1818	#if ANSI
1819	void fmt_inicio_grupos_vfields(instruction_code instr_inicial,
1820	instruction_code instr_final)
1821	#else /ANSI/
1822	void fmt_inicio_grupos_vfields(instr_inicial,instr_final)
1823	instruction_code instr_inicial,instr_final;
1824	#endif /ANSI/
1825	#endif /* CICPP */
1826	{
1827	elem.classe=logical;
1828	elem.op.l=rep_group;
1829	push(&elem);
1830	IFERR_RET;
1831	rep_group=false;
1832
1833	elem.classe=integer;
1834	elem.op.i=next_rep_occ;
1835	push(&elem);
1836	IFERR_RET;
1837	next_rep_occ=0;
1838
1839	elem.classe=logical;
1840	elem.op.boolean=must_repeat;
1841	push(&elem);
1842	IFERR_RET;
1843	must_repeat=false;
1844	/* Continue em grupos repetitivos 17-7-94 */
1845
1846	elem.classe=integer;
1847	elem.op.i=continue_rgroup_maxocc;
1848	push(&elem);
1849	IFERR_RET;
1850	continue_rgroup_maxocc=0;
1851	#if TRACE_REPF
1852	printf("\n [Beg_init_rep <push>] rep_goup=%d next_rep_occ=%d",
1853	rep_group,next_rep_occ);
1854	#endif
1855	fmt_fim=false;
1856	fmt_n_ref=1;
1857	/* Continue em grupos repetitivos 17-7-94 */
1858	continue_rgroup_maxocc=0;
1859	rpni=(l_code *)ni->next;
1860	while (fmt_fim==false) {
1861	if(infoi(rpni)==instr_inicial) fmt_n_ref++;
1862	if(infoi(rpni)==instr_final ) fmt_n_ref--;
1863	if(fmt_n_ref==0) fmt_fim=true;
1864	else {
1865	/* Continue em grupos repetitivos 17-7-94 */
1866	/* Inicializa contadores de instrucoes que referenciam fields
1867	para determinar o numero maximo de ocorrencias dos campos
1868	Notar que quando funcionar grupos repetitivos aninhados
1869	so interessam o do primeiro nivel. Para o microsisis
1870	original , esse aninhamento nao e possivel. */
1871	fmt_init_vinstr(rpni,fmt_n_ref);
1872	}
1873	rpni=(l_code *)rpni->next;
1874	}
1875	}
1876	/-------------------------------------------------------------------------/
1877	/* fmt_fim_grupos_vfields */
1878	/-------------------------------------------------------------------------/
1879	#if CICPP
1880	void FMTSTRU :: fmt_fim_grupos_vfields(void)
1881	#else /* CICPP */
1882	void fmt_fim_grupos_vfields()
1883	#endif /* CICPP */
1884	{
1885	/* Implementacao de continue 17-7-94 */
1886	auxpop = pop(); IFERR_RET;
1887	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1888	is_not_of_class(op1->classe,integer);
1889	IFERR_RET;
1890	continue_rgroup_maxocc=op1->op.i ;
1891
1892	auxpop = pop(); IFERR_RET;
1893	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1894	is_not_of_class(op1->classe,logical);
1895	IFERR_RET;
1896	must_repeat=op1->op.boolean ;
1897
1898	auxpop = pop(); IFERR_RET;
1899	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1900	is_not_of_class(op1->classe,integer);
1901	IFERR_RET;
1902	next_rep_occ=op1->op.i ;
1903
1904	auxpop = pop(); IFERR_RET;
1905	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1906	is_not_of_class(op1->classe,logical);
1907	IFERR_RET;
1908	rep_group=op1->op.boolean ;
1909	}
1910
1911	/-------------------------------------------------------------------------/
1912	/* fmt_load_all_occ */
1913	/-------------------------------------------------------------------------/
1914	#if CICPP
1915	int FMTSTRU :: fmt_load_all_occ(void)
1916	#else /* CICPP */
1917	int fmt_load_all_occ()
1918	#endif /* CICPP */
1919	{
1920	int occ;
1921	occ=0;
1922	*fd_value=null_char;
1923	itf=(field_definition_node *) iadd(ni);
1924	#if CICPP /ifcmm/
1925	itf->max_occ=recp->xnocc(itf->tag);
1926	#else /elsecmm/
1927	itf->max_occ=nocc(irec,itf->tag);
1928	#endif /CICPP/ /endcmm/
1929	/* inicio implementacao [x:y] */
1930	itf->execlower=abs(itf->lower);
1931	itf->execupper=abs(itf->upper);
1932	if (itf->lower==LASTVAL) itf->execlower=itf->max_occ;
1933	if (itf->upper==LASTVAL) itf->execupper=itf->max_occ;
1934	/* fim implementacao [x:y] */
1935	/* we must verify in which occurrences the subfield appears */
1936	while (itf->max_occ > itf->actual_occ ) {
1937	if ( ( itf->actual_occ+1 < itf->execlower) \|\|
1938	( itf->actual_occ+1> itf->execupper) ) {
1939	itf->actual_occ ++;
1940	continue ;
1941	}
1942	*fd_tmp=null_char;
1943	itf->actual_occ++;
1944	#if CICPP /ifcmm/
1945	pos=recp->xfieldx(itf->tag,itf->actual_occ );
1946	#else /elsecmm/
1947	pos=fieldx(irec,itf->tag,itf->actual_occ );
1948	#endif /CICPP/ /endcmm/
1949	field_value(fd_tmp,max_fd_tmp,pos);
1950	#if DEB_NOCC
1951	printf("\n fd_tmp=%s",fd_tmp);
1952	#endif
1953	sub_field_string(fd_tmp,itf->sub_field);
1954	#if !FATRAP
1955	if (fmterror) return -1;
1956	#endif
1957	#if DEB_NOCC
1958	printf("\n fd_tmp=%s",fd_tmp);
1959	#endif
1960	if (itf->offset != -1 && itf->length != -1)
1961	fd_tmp=sub_string(fd_tmp,itf->offset,itf->length);
1962	#if DEB_NOCC
1963	printf("\n fd_tmp=%s",fd_tmp);
1964	#endif
1965	if(strlen(fd_tmp)!=0) {
1966	occ++;
1967	if(itf->first_occ==0) itf->first_occ=itf->actual_occ;
1968	itf->last_occ=itf->actual_occ;
1969	}
1970	strcat(fd_value,fd_tmp);
1971	#if DEB_NOCC
1972	printf("\n fd_value=%s occ=%d",fd_value,occ);
1973	#endif
1974	#if DEB_FLOAT
1975	trace_field(itf,fd_tmp);
1976	trace_field(itf,fd_value);
1977	#endif
1978	}
1979	itf->actual_occ=0;
1980
1981	if (fmttrace) trace_field(itf,fd_tmp); /* AOT 26/12/91 */
1982	return occ;
1983	}
1984	/-------------------------------------------------------------------------/
1985	/* fmt_load_next_occ */
1986	/-------------------------------------------------------------------------/
1987	#if CICPP
1988	void FMTSTRU :: fmt_load_next_occ(void)
1989	#else /* CICPP */
1990	void fmt_load_next_occ()
1991	#endif /* CICPP */
1992	{ /*[:] Para grupo repetitivo pega somente e sempre o limite
1993	inferior da ocorrencia
1994	*/
1995	int occx;
1996	*fd_value=null_char;
1997	occx=itf->actual_occ;
1998	if (rep_group==true && !NO_INTERVAL(itf) ) occx=itf->execlower;
1999	if ( (occx < itf->execlower) \|\| (occx > itf->execupper) ) return;
2000	/[:]/
2001	#if CICPP /ifcmm/
2002	pos=recp->xfieldx(itf->tag,occx);
2003	#else /elsecmm/
2004	pos=fieldx(irec,itf->tag,occx);
2005	#endif /CICPP/ /endcmm/
2006	field_value(fd_value,max_fd_value,pos);
2007	/* subfields */
2008	cc=itf->sub_field;
2009	if (cc!=subfield_null){
2010	sub_field_string(fd_value,cc);
2011	IFERR_RET;
2012	}
2013	/substring/
2014	if(itf->offset!= -1 && itf->length!= -1)
2015	strcpy(fd_value,sub_string(fd_value,itf->offset,itf->length));
2016	}
2017	/-------------------------------------------------------------------------/
2018	/* fmt_comum_ref_beg */
2019	/-------------------------------------------------------------------------/
2020	#if CICPP /ifcmm/
2021	void FMTSTRU :: fmt_comum_ref_beg(void)
2022	{
2023	try { recp=new RECSTRU(cisisxp); }
2024	catch (BAD_ALLOC) { fatal("fmt/inter/refrec/ALLOC"); }
2025	recp->xrecalloc(MAXMFRL); /* p/ manter check: pode nao usar */
2026	/* recp is global */
2027	}
2028	#else /elsecmm/
2029	void fmt_comum_ref_beg()
2030	{
2031	if (currprat >= MAXREFS) fatal("fmt/inter/refrec/MAXREFS");
2032	if (!nrecs) fatal("fmt/inter/refrec/recinit");
2033	for (irec=maxnrec; irec--; )
2034	if (!vrecp[irec]) /* ja' decrementado */ break;
2035	if (irec < 0) fatal("fmt/inter/refrec/next");
2036	currprat++;
2037	vprats[currprat]=irec;
2038	recallok(irec,MAXMFRL); /* p/ manter check: pode nao usar */
2039	recp=vrecp[irec]; /* mandatory for defines REC RDB MF0 MFR DIR, FIELDP */
2040	}
2041	#endif /CICPP/ /endcmm/
2042	/-------------------------------------------------------------------------/
2043	/* fmt_comum_ref_end */
2044	/-------------------------------------------------------------------------/
2045	#if CICPP /ifcmm/
2046	void FMTSTRU :: fmt_comum_ref_end(void)
2047	{
2048	auxpop = pop(); IFERR_RET;
2049	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2050	is_not_of_class(top->classe,type_recstru);
2051	IFERR_RET;
2052	#if BEFORE990414
2053	// nao liberava nada! - AOT/HB
2054	#else
2055	if (ref_mfn_number>0){
2056	delete recp;
2057	}
2058	#endif
2059	recp=top->op.lrecp;
2060	}
2061	#else /elsecmm/
2062	void fmt_comum_ref_end()
2063	{
2064	LONGX trec;
2065	auxpop = pop(); IFERR_RET;
2066	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2067	is_not_of_class(top->classe,long_n);
2068	IFERR_RET;
2069	trec=top->op.l;
2070	/* A alocacao so foi feita se foi gerado mfn valido(>0) pelo ref */
2071	if (ref_mfn_number>0){
2072	/* recp=vrecp[trec];/ / e' necessario? / / YES */
2073	if (currprat < 0 \|\| !vrecp[vprats[currprat]]) fatal("fmt/inter/refrec/free");
2074	irec=vprats[currprat];
2075	FREE(vrecp[irec]); vrecp[irec]=NULL; nrecs--;
2076	currprat--; /Posiciona na prateleira anterior /
2077
2078	/* irec=vprats[currprat];*/
2079	}
2080	irec=trec;
2081	recp=vrecp[irec];/* mandatory for defines REC RDB MF0 MFR DIR, FIELDP */
2082	}
2083	#endif /* CICPP / /endcmm*/
2084
2085	/----------- inter --------------------------------------/
2086	#if CICPP
2087	LONGX FMTSTRU :: xfmt_inter(RECSTRU *parmrecp,
2088	LONGX par_lw,
2089	char *par_out,
2090	LONGX outsize)
2091	#else /* CICPP */
2092	LONGX fmt_inter(pgm,parmirec,par_lw,par_out,outsize)
2093	l_code *pgm;
2094	LONGX parmirec;
2095	LONGX par_lw;
2096	char *par_out;
2097	LONGX outsize;
2098	#endif /* CICPP */
2099	{
2100	char v_mfn_str[20],*mfn_str;
2101	/A06/
2102	/* char literal[MAX_LITER+1]; virou dinamico e global*/
2103	char *new_dbname;
2104	instruction_code actual_mode;
2105	int fim_pgm;
2106	int i;
2107	/* para colocar string na saida */
2108	char pre_literal,suf_literal,nothing;
2109	char *s;
2110	int id1;
2111	int id2;
2112	int final_added;
2113	LONGX qty;
2114	instruction_code next_ins;
2115	l_code *next_ni;
2116	#if DINALLOC
2117	int xdir;
2118	LONGX xfsiz;
2119	#endif
2120
2121	if (!ndbxs) dbxinit(); /* init vdbxp/vrecp/vtrmp if not yet init - AOT, 28/10/2005 */
2122
2123	#if CICPP
2124	l_code *pgm = fmt_pgmp;
2125	#endif /* CICPP */
2126	/--------------------------------------------------------------------------/
2127	/* NewLine-Valor default */
2128	/--------------------------------------------------------------------------/
2129	/* A07*/
2130
2131	#if UNIX \| WWWISIS
2132	nl_LEN=1;
2133	nl_STR=fmt_alloc_char((ALLOPARM)(nl_LEN+1),"cifm3/alloc/nl_STR");
2134	nl_STR[0]=lf; nl_STR[1]=null_char;
2135	#else
2136	nl_LEN=2;
2137	nl_STR=fmt_alloc_char((ALLOPARM)(nl_LEN+1),"cifm3/alloc/nl_STR");
2138	nl_STR[0]=cr; nl_STR[1]=lf; nl_STR[2]=null_char;
2139	#endif
2140	if (fmttrace) printf("+++ fmt_inter - begin \n"); /* AOT 27/12/91 */
2141	strcpy(fmterrxy,"");
2142	#if FATRAP
2143	fmterror = setjmp(fmtjumper);
2144	#else /* FATRAP */
2145	fmterror = 0;
2146	ERROR_LABEL:
2147	#endif /* FATRAP */
2148	if (fmterror != 0) {
2149	return((fmterror < 0) ? (LONGX)fmterror : (LONGX)(-fmterror));
2150	}
2151
2152	if (par_lw <= 0) par_lw=MAXMFRL-1; /* AOT, 07/06/2005 */
2153	if (par_lw >= outsize) par_lw=outsize-1; /* AOT, 07/06/2005 */
2154
2155	/* set current master file record */
2156	#if CICPP /ifcmm/
2157	recp=parmrecp;
2158	#else /elsecmm/
2159	irec=parmirec;
2160	recp=vrecp[irec];
2161	vprats[currprat]=irec;
2162	#endif /CICPP/ /endcmm/
2163
2164	firstdbnp=RDBname;
2165
2166	/* Alocacao das maiores areas originalmente estaticas - AOT 29/12/90 */
2167	#if DINALLOC
2168	max_tmp_str=outsize; /* parm asize */
2169	#if !RETIRAR
2170	#if CICPP
2171	try
2172	{ tmp_str= (char *)new char [(max_tmp_str+1)]; }
2173	catch (BAD_ALLOC)
2174	{ tmp_str= (char *) NULL; }
2175	#else /* CICPP */
2176	tmp_str=(char *)ALLOC((ALLOPARM)(max_tmp_str+1));
2177	#endif /* CICPP */
2178	#else /RETIRAR /
2179	tmp_str=fmt_alloc_char((ALLOPARM)(max_tmp_str+1),"1001");
2180	#endif /RETIRAR /
2181	if (tmp_str == NULL)
2182	{
2183	#if !RETIRAR
2184	inter_error("1001");
2185	#endif
2186	IFERR_GOTO;
2187	}
2188	/A06/
2189	literal_len =(ALLOPARM)MAX_LITER;
2190	literal=fmt_alloc_char((ALLOPARM)(literal_len+1),"cifm3/alloc/literal");
2191	if (literal == NULL) IFERR_GOTO;
2192
2193	if (fmt_fsiz) {
2194	max_fd_value=fmt_fsiz;
2195	max_fd_tmp=fmt_fsiz;
2196	}
2197	else {
2198	for (xdir=MFRnvf, din_fsiz=0; xdir--; )
2199	if (DIRlen(xdir) > din_fsiz) din_fsiz=DIRlen(xdir);
2200	if (fmttrace) printf("+++ fmt_inter - din_fsiz=%ld\n",din_fsiz);
2201	if (din_fsiz < par_lw) din_fsiz=par_lw; /* bug lw=999 */
2202	if (fmttrace) printf("+++ fmt_inter - din_fsiz=%ld\n",din_fsiz);
2203	max_fd_value=din_fsiz;
2204	max_fd_tmp=din_fsiz;
2205	}
2206
2207	#if CICPP
2208	try
2209	{ v_fd_value= (char *) new char [(max_fd_value+1)]; }
2210	catch (BAD_ALLOC)
2211	{ v_fd_value= NULL; }
2212	#else /* CICPP */
2213	v_fd_value= (char *)ALLOC((ALLOPARM)(max_fd_value+1));
2214	#endif /* CICPP */
2215	if (v_fd_value==(char *)NULL)
2216	{
2217	inter_error("1003");
2218	IFERR_GOTO;
2219	}
2220	#if CICPP
2221	try
2222	{ v_fd_tmp= (char *) new char [(max_fd_tmp+1)]; }
2223	catch (BAD_ALLOC)
2224	{ v_fd_tmp= (char *) NULL;}
2225	#else /* CICPP */
2226	v_fd_tmp= (char *)ALLOC((ALLOPARM)(max_fd_tmp+1));
2227	#endif /* CICPP */
2228	if (v_fd_tmp== (char *)NULL)
2229	{
2230	inter_error("1004");
2231	IFERR_GOTO;
2232	}
2233	#endif
2234
2235	/* Sindo's code */
2236	continue_rgroup_maxocc=0;
2237	continue_rgroup=false;
2238
2239	/* Inicializacao do stack[] - AOT 27/11/91 */
2240	stack_pt=0; /* push() e pop() usam a partir de 1 - comunicar */
2241
2242	op1= &op1_node;
2243	op2= &op2_node;
2244	top= &top_node;
2245	out= &par_out[0];
2246	lw_inter=par_lw;
2247
2248	/* incializacoes */
2249	fd_value=v_fd_value; /* DINALLOC */
2250	mfn_str=v_mfn_str;
2251	must_repeat=false;
2252	rep_group=false;
2253	next_rep_occ=0;
2254	pstr_num=str_num;
2255
2256	nextcc=1;
2257	tmp_str_index=0;
2258	nothing=null_char;
2259	pre_literal= &nothing;
2260	suf_literal= &nothing;
2261	erro_fatal=0;
2262
2263	out[0]=null_char;
2264	pout= 0;
2265	address_out=out;
2266
2267	/* defaults */
2268
2269	actual_mode=mpl_par;
2270	final_added=0;
2271
2272	fim_pgm= ~false;
2273	if (pgm)
2274	if (pgm->next) {
2275	/* inicializa A tabela de definicao de fields */
2276	ni=(l_code )pgm->next; / next instruction */
2277	for (;next_infoi(ni)!=(int)nulo;){
2278	fmt_init_vinstr(ni,0);
2279	ni=(l_code *)ni->next;
2280	}
2281	fim_pgm=false;
2282	ni=(l_code )pgm->next; / next intruction */
2283	}
2284
2285	/* 22/10/99 Inicializa as variaveis E e S */
2286	fmt_init_E_S();
2287
2288
2289	while (fim_pgm==false){
2290	fd_tmp=v_fd_tmp;
2291
2292	#if TRACE_INTER_X
2293	if (fmttrace)
2294	printf(" #%d[%d,%s,%d]\n",0,ni->info.lab,
2295	inst_cnv[ni->info.instr], ni->info.add);
2296	#endif /* TRACE_INTER_X */
2297	#if DEBUG_REF
2298	printf("\n #%d[%d,%s,%d]\n",0,ni->info.lab,
2299	inst_cnv[ni->info.instr], ni->info.add);
2300
2301	printf("\n---- ESTADO da pilha ----- termos %d \n",ntrms);
2302	for (iii=stack_pt;iii>0;iii--) {
2303	printf("\n %d %d %d ",iii,stack[iii].classe, stack[iii].op);
2304	if (stack[iii].classe==string) printf(" string");
2305	if (stack[iii].classe==long_n) printf(" long_n %ld ",stack[iii].op.l);
2306	if (stack[iii].classe==integer) printf(" integer");
2307	if (stack[iii].classe==float_n) printf(" float_n ");
2308	if (stack[iii].classe==logical) printf(" logical %d ",stack[iii].op.i);
2309	if (stack[iii].classe==ptr) printf(" ptr %ld (%p)",
2310	stack[iii].op.address,stack[iii].op.address);
2311	if (stack[iii].classe==l_w) printf(" l_w =%ld ",stack[iii].op.l);
2312	if (stack[iii].classe==xindex) printf(" index %d ",stack[iii].op.i);
2313	if (stack[iii].classe==next_cc) printf(" next_cc %ld",stack[iii].op.l);
2314
2315	}
2316	#if 0
2317	printf("\n ---- Alocacoes invertido --- ntrms=%d",
2318	ntrms);
2319	for (iix=maxntrm; iix>=trm_prat; iix--) {
2320	printf ("\n vtrmp[%ld]= %ld (%p )", iix,vtrmp[iix],vtrmp[iix]);
2321	}
2322	#endif
2323	#endif
2324	/loop/
2325	switch(infoi(ni))
2326	{
2327	case test_occ:
2328	{
2329	itf=(field_definition_node *) iadd(ni);
2330	there_is_fd_value=false;
2331	fd_value=null_char; / 08/05/92 */
2332	fd_tmp=null_char; / 08/05/92 */
2333	if (itf->max_occ == -1)
2334	{ fmt_load_all_occ(); IFERR_GOTO; }
2335
2336	if(rep_group==true)itf->actual_occ=next_rep_occ;
2337	else itf->actual_occ++;
2338	/* Tentativa de Implementar v70[1] dentro de repetitivo */
2339	/* 30-12-94 */
2340	if (rep_group==true && !NO_INTERVAL(itf)) {
2341	/* Intervalo dentro de repetitivo so pega o lower
2342	O comando abaixo forca o valor de itf->actual_occ
2343	somente com o objetivo de entrar no proximo teste,
2344	pois de qualquer forma o numero da ocorrencia sera
2345	aquele especificado no lower.
2346	Esta implementacao e muito suja. No caso de um
2347	formato do tipo ( v70[2],c20,v26[3]) se nocc(70)=5
2348	serao geradas 5 linhas iguais !!!!
2349	*/
2350	itf->actual_occ=itf->max_occ;
2351	}
2352
2353	if (itf->max_occ >= itf->actual_occ){
2354	there_is_fd_value=false;
2355	elem.classe=logical;
2356	elem.op.boolean=true;
2357	fmt_load_next_occ();
2358	IFERR_GOTO;
2359	if(strlen(fd_value)!=0)there_is_fd_value=true;
2360
2361	if (fmttrace) trace_field(itf,fd_value);/* AOT 26/12/91 */
2362	}
2363	else {
2364	*fd_value=null_char;
2365	elem.classe=logical;
2366	elem.op.boolean=false;
2367	if (fmttrace) trace_field(itf,""); /* AOT 26/12/91 */
2368	}
2369
2370	push(&elem);
2371	IFERR_GOTO;
2372	ni=(l_code ) next_infoi(ni); / proxima instrucao */
2373	break;
2374	}
2375	case suf_cond :
2376	case suf_cond_null :
2377	case suf_r_lit :
2378	case suf_r_lit_plus :
2379	{
2380	ni=(l_code *) next_infoi(ni);
2381	break;
2382	}
2383
2384	case ign_cond :
2385	{
2386	there_is_fd_value=false;
2387	ni=(l_code *) next_infoi(ni);
2388	break;
2389	}
2390
2391	case pre_cond :
2392	{
2393	if (there_is_fd_value==true)
2394	{
2395	if(itf->actual_occ==itf->first_occ)
2396	{
2397	literal[0]=null_char;
2398	#if !RETIRAR
2399	strcpy(literal, (char *) iadd(ni) );
2400	#else
2401	literal=fmt_copy_realloc((char *)literal, &literal_len,
2402	(char *)iadd(ni));
2403	#endif
2404	if(is_upper_mode(actual_mode)) upcase_mode(literal);
2405	id1=0;
2406	id2=0;
2407	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2408	} /* actual_occ=... */
2409	}
2410
2411	ni=(l_code *) next_infoi(ni);
2412	break;
2413	}
2414
2415	case pre_r_lit_plus :
2416	{
2417	pre_literal= &nothing;
2418
2419	if(itf->actual_occ!=itf->first_occ && there_is_fd_value==true)
2420	{
2421	pre_literal=(char *) iadd(ni);
2422
2423	} /* actual_occ=... */
2424	ni=(l_code *) next_infoi(ni);
2425	break;
2426	}
2427
2428	case pre_r_lit :
2429	{
2430
2431	if(there_is_fd_value==true) pre_literal=(char *) iadd(ni);
2432	ni=(l_code *) next_infoi(ni);
2433	break;
2434	}
2435
2436
2437	case u_cond :
2438	{ /A06/
2439
2440	/* literal[0]=null_char;
2441	strcpy(literal,(char *) iadd(ni) );
2442	*/
2443	literal=fmt_copy_realloc((char *)literal, &literal_len,
2444	(char *)iadd(ni));
2445	if(is_upper_mode(actual_mode)) upcase_mode(literal);
2446	id1=0;
2447	id2=0;
2448	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2449	ni=(l_code *) next_infoi(ni);
2450	break;
2451	}
2452
2453	case escape_seq :
2454	{
2455	literal[0]=(char)27; /escape sequence /
2456	literal[1]=null_char;
2457	/A06/
2458	id1=0;
2459	id2=0;
2460	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2461
2462	/* A06 strcat(literal, (char *) iadd(ni) );
2463	*/
2464	literal=fmt_copy_realloc((char *)literal, &literal_len,
2465	(char *)iadd(ni));
2466	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2467	ni=(l_code *) next_infoi(ni);
2468	break;
2469
2470	}
2471	case fmt_beg:
2472	{
2473	save_context(modify_fmt_pointers);
2474	IFERR_GOTO;
2475	ni=(l_code *) next_infoi(ni);
2476	break;
2477	}
2478
2479	case fmt_end:
2480	{
2481
2482
2483	ni=(l_code *) next_infoi(ni);
2484
2485	break;
2486	}
2487	case print_mfn :
2488	{
2489	/* strcpy(mfn_str,long_to_char(MFRmfn,(int )iadd(ni)) );*/
2490	float_exp_value= (float_x ) MFRmfn;
2491	strcpy((char *)mfn_str,
2492	fmt_float_numb(float_exp_value,(int )iadd(ni) ,(int) 0,'0'));
2493	id1=0;
2494	id2=0;
2495	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,mfn_str);
2496	ni=(l_code *) next_infoi(ni);
2497	break;
2498	}
2499
2500	case print_maxmfn :
2501	{
2502	float_exp_value= (float_x ) 0;
2503	if (RECdbxp) float_exp_value= (float_x ) RDBmsmfn; /* il fault faire.. */
2504	strcpy((char *)mfn_str,
2505	fmt_float_numb(float_exp_value,(int )iadd(ni) ,(int) 0,'0'));
2506	id1=0;
2507	id2=0;
2508	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,mfn_str);
2509	ni=(l_code *) next_infoi(ni);
2510	break;
2511	}
2512
2513	case print_core :
2514	{
2515	#if CICPP
2516	float_exp_value= (float_x ) 0;
2517	#else /* CICPP */
2518	float_exp_value= (float_x ) CORELEFT();
2519	#endif /* CICPP */
2520	strcpy((char *)mfn_str,
2521	fmt_float_numb(float_exp_value,(int )iadd(ni) ,(int) 0,'0'));
2522	id1=0;
2523	id2=0;
2524	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,mfn_str);
2525	ni=(l_code *) next_infoi(ni);
2526	break;
2527	}
2528
2529	case print_field:
2530	{
2531	char *tofree;
2532
2533	if(itf->max_occ>itf->actual_occ) must_repeat=true;
2534	if (there_is_fd_value==true)
2535	{
2536	*fd_tmp=null_char;
2537	strcpy(fd_tmp,pre_literal);
2538	strcat(fd_tmp,fd_value);
2539	/* exec_suf_literal; */
2540	next_ni=(l_code )next_infoi(ni); / precisa ver 1 passo a frente*/
2541	next_ins=infoi(next_ni);
2542	there_is_suf=false;
2543
2544	if (next_ins==suf_r_lit )
2545	{
2546	ni=(l_code *) next_infoi(ni);
2547	suf_literal=(char *) iadd(ni);
2548	there_is_suf=true;
2549	}
2550
2551	next_ni=(l_code )next_infoi(ni); / precisa ver 1 passo a frente*/
2552	next_ins=infoi(next_ni);
2553
2554	if (next_ins==suf_r_lit_plus)
2555	{ ni=(l_code *) next_infoi(ni);
2556	/* ignores the last occurrence */
2557	if(itf->actual_occ!=itf->last_occ)
2558	{
2559	suf_literal= (char *) iadd(ni);
2560	there_is_suf=true;
2561	}
2562	}
2563	strcat(fd_tmp,suf_literal);
2564	literal[0]=null_char;
2565	next_ni=(l_code )next_infoi(ni); / precisa ver 1 passo a frente*/
2566	next_ins=infoi(next_ni);
2567
2568	if (next_ins==suf_cond_null \|\| next_ins==suf_cond)
2569	{ ni=(l_code *) next_infoi(ni);
2570	if(itf->actual_occ==itf->last_occ )
2571	{
2572	/A06 strcpy(literal, (char ) iadd(ni) );
2573	*/
2574	literal=fmt_copy_realloc((char *)literal, &literal_len,
2575	(char *)iadd(ni));
2576	there_is_suf=true;
2577	} /* else ignores command */
2578	} /* suf_cond */
2579	strcat(fd_tmp,literal);
2580	s=trata_md(actual_mode,fd_tmp,&final_added,&tofree);
2581	IFERR_GOTO;
2582	if(is_upper_mode(actual_mode)) upcase_mode(s);
2583	id1=itf->indent1;
2584	id2=itf->indent2;
2585	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,s);
2586	if (tofree) {
2587
2588	#if CICPP
2589	delete [] (char *)tofree;
2590	#else /* CICPP */
2591	FREE(tofree);
2592	#endif /* CICPP */
2593
2594	}
2595	if(there_is_suf==true)
2596	{
2597	delete_chars(out,pout,nextcc,final_added,lw_inter);
2598	}
2599
2600	}
2601	pre_literal= &nothing;
2602	suf_literal= &nothing;
2603	ni=(l_code *) next_infoi(ni);
2604	break;
2605
2606	}
2607
2608	case load_field_all:
2609	{
2610	fmt_load_all_occ();
2611	IFERR_GOTO;
2612	#if TRACE_INTER_2
2613	printf("\n Apos fmt_load_all_occ/1 fd_value=%s",fd_value);
2614	#endif
2615	/* copia para temporaria */
2616
2617	elem.op.s=store_tmp_string(fd_value);
2618	IFERR_GOTO;
2619	elem.classe=string;
2620	push(&elem);
2621	IFERR_GOTO;
2622	ni=(l_code *) next_infoi(ni);
2623	break;
2624	}
2625	case load_field_occ:
2626	{
2627	itf=(field_definition_node *)iadd(ni);
2628	if( itf->max_occ == -1)
2629	{
2630	#if CICPP /ifcmm/
2631	itf->max_occ=recp->xnocc(itf->tag);
2632	#else /elsecmm/
2633	itf->max_occ=nocc(irec,itf->tag);
2634	#endif /CICPP/ /endcmm/
2635	itf->execlower=abs(itf->lower);
2636	itf->execupper=abs(itf->upper);
2637	if (itf->lower==LASTVAL) itf->execlower=itf->max_occ;
2638	if (itf->upper==LASTVAL) itf->execupper=itf->max_occ;
2639	/* fim implementacao [x:y] */
2640
2641	itf->actual_occ=0;
2642	}
2643	*fd_value=null_char;
2644	if (rep_group==true)itf->actual_occ=next_rep_occ;
2645	else itf->actual_occ++;
2646
2647	if (itf->max_occ > itf->actual_occ) must_repeat=true; /* SVD 11/11/91 */
2648
2649	if (itf->max_occ >= itf->actual_occ \|\| !NO_INTERVAL(itf)){
2650	*fd_value=null_char;
2651	fmt_load_next_occ();
2652	IFERR_GOTO;
2653	}
2654
2655	elem.op.s=store_tmp_string(fd_value);
2656	IFERR_GOTO;
2657	elem.classe=string;
2658	push(&elem);
2659	IFERR_GOTO;
2660	ni=(l_code *) next_infoi(ni);
2661	break;
2662	}
2663
2664	case load_string:
2665	{
2666	elem.op.s=(char *) iadd(ni);
2667	elem.classe=string;
2668	push(&elem);
2669	IFERR_GOTO;
2670	ni=(l_code *) next_infoi(ni);
2671	break;
2672	}
2673	case load_mstnam:
2674	{
2675	tmp_ptr=store_tmp_string(RDBname);
2676	IFERR_GOTO;
2677	if(is_upper_mode(actual_mode)) upcase_mode(tmp_ptr);
2678
2679	elem.op.s=tmp_ptr;
2680	elem.classe=string;
2681	push(&elem);
2682	IFERR_GOTO;
2683	ni=(l_code *) next_infoi(ni);
2684	break;
2685	}
2686	case load_date:
2687	{
2688	char *tmp_ptr;
2689	int parmdate;
2690	parmdate=(int)iadd(ni);
2691
2692	tmp_ptr=fmt_get_date(parmdate,-1L);
2693	if(is_upper_mode(actual_mode)) upcase_mode(tmp_ptr);
2694
2695	elem.op.s=store_tmp_string(tmp_ptr);
2696	IFERR_GOTO;
2697	elem.classe=string;
2698	push(&elem);
2699	IFERR_GOTO;
2700	ni=(l_code *) next_infoi(ni);
2701	break;
2702	}
2703	case load_number:
2704	{ /* Only implemented for LONGX numbers */
2705	elem.op.l=(LONGX)iadd(ni);
2706	elem.classe=long_n;
2707	push(&elem);
2708	IFERR_GOTO;
2709	ni=(l_code *) next_infoi(ni);
2710	break;
2711	}
2712	case intvvalue:
2713	{ /* Only implemented for LONGX numbers */
2714	elem.op.r=E_var[(LONGX)iadd(ni)];
2715	elem.classe=float_n;
2716	push(&elem);
2717	IFERR_GOTO;
2718	ni=(l_code *) next_infoi(ni);
2719	break;
2720	}
2721	case load_float:
2722	{
2723	elem.op.r= (float_x )(iadd(ni)) ;
2724	#if DEB_FLOAT
2725	printf("\n Empilhando float=%f",elem.op.r);
2726	#endif
2727	elem.classe=float_n;
2728	push(&elem);
2729	IFERR_GOTO;
2730	ni=(l_code *) next_infoi(ni);
2731	break;
2732	}
2733	case load_mfn:
2734	{ /* tamanho de caracteres sao ignorados */
2735	elem.op.l=(LONGX)MFRmfn;
2736	elem.classe=long_n;
2737	push(&elem);
2738	IFERR_GOTO;
2739	ni=(l_code *) next_infoi(ni);
2740	break;
2741	}
2742
2743	case load_maxmfn:
2744	{ /* tamanho de caracteres sao ignorados */
2745	elem.op.l= (float_x ) 0;
2746	if (RECdbxp) elem.op.l= (float_x ) RDBmsmfn; /* il fault faire.. */
2747	elem.classe=long_n;
2748	push(&elem);
2749	IFERR_GOTO;
2750	ni=(l_code *) next_infoi(ni);
2751	break;
2752	}
2753	case load_core:
2754	{ /* tamanho de caracteres sao ignorados */
2755	#if CICPP
2756	elem.op.l= (float_x ) 0;
2757	#else /* CICPP */
2758	elem.op.l= (float_x ) CORELEFT();
2759	#endif /* CICPP */
2760	elem.classe=long_n;
2761	push(&elem);
2762	IFERR_GOTO;
2763	ni=(l_code *) next_infoi(ni);
2764	break;
2765	}
2766
2767	case noccins:
2768	{
2769	elem.op.l=fmt_load_all_occ();
2770	IFERR_GOTO;
2771	elem.classe=long_n;
2772	push(&elem);
2773	IFERR_GOTO;
2774	#if DEB_NOCC
2775	printf("\n Numero de ocorrencias=%d\n",elem.op.l);
2776	#endif
2777	ni=(l_code *) next_infoi(ni);
2778	break;
2779	}
2780
2781	case ioccins:
2782	{
2783	elem.op.l=(LONGX )next_rep_occ;
2784	elem.classe=long_n;
2785	push(&elem);
2786	IFERR_GOTO;
2787	#if DEB_NOCC
2788	printf("\n Numero de ocorrencias=%d\n",elem.op.l);
2789	#endif
2790	ni=(l_code *) next_infoi(ni);
2791	break;
2792	}
2793
2794	case present :
2795	case absent :
2796	{
2797	#if ONE_MORE_OCCS
2798	if (itf->max_occ>itf->actual_occ) must_repeat=true; /* SVD 21/11/91 */
2799	#endif
2800	if (rep_group==true)
2801	{
2802	/* copia para temporaria */
2803	itf=(field_definition_node *)iadd(ni);
2804	if( itf->max_occ == -1)
2805	{
2806	fmt_load_all_occ(); /* para inicializar intervalos 27-12-94 */
2807	IFERR_GOTO;
2808	itf->actual_occ=0;
2809	}
2810	*fd_value=null_char;
2811	itf->actual_occ=next_rep_occ;
2812	#if !ONE_MORE_OCCS
2813	if (itf->max_occ>itf->actual_occ) must_repeat=true; /* SVD 21/11/91 */
2814	#endif
2815	if (itf->max_occ >= itf->actual_occ) {fmt_load_next_occ();IFERR_GOTO;}
2816	}
2817	else {
2818	fmt_load_all_occ();
2819	IFERR_GOTO;
2820	#if TRACE_INTER_2
2821	printf("\n Apos fmt_load_all_occ/2 fd_value=%s",fd_value);
2822	#endif
2823	}
2824	elem.classe=logical;
2825	if (infoi(ni)==absent) elem.op.boolean= *fd_value==null_char?true:false;
2826	if (infoi(ni)==present) elem.op.boolean= *fd_value==null_char?false:true;
2827	push(&elem);
2828	IFERR_GOTO;
2829	ni=(l_code *) next_infoi(ni);
2830	break;
2831	}
2832
2833	case duptop: /duplica a expressao do select para testar com cases /
2834	{
2835	auxpop = pop(); IFERR_GOTO;
2836	push(auxpop); IFERR_GOTO;
2837	push(auxpop); IFERR_GOTO;
2838	ni=(l_code *) next_infoi(ni);
2839	break;
2840	}
2841	case end_select: /* retira a expressao do select do topo */
2842	{
2843	auxpop =pop(); IFERR_GOTO;
2844	ni=(l_code *) next_infoi(ni);
2845
2846	break;
2847	}
2848	case jumpf:
2849	{
2850	auxpop = pop(); IFERR_GOTO;
2851	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2852	is_not_of_class(top->classe,logical);
2853	IFERR_GOTO;
2854	if(top->op.boolean==false) ni=(l_code *) iadd(ni);
2855	else ni=(l_code *) next_infoi(ni);
2856	break;
2857
2858	}
2859
2860	case jumpt:
2861	{
2862	auxpop = pop(); IFERR_GOTO;
2863	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2864	is_not_of_class(top->classe,logical);
2865	IFERR_GOTO;
2866
2867	if(top->op.boolean==true) ni=(l_code *) iadd(ni);
2868	else ni=(l_code *) next_infoi(ni);
2869
2870	break;
2871	}
2872
2873	case jump:
2874	case breakins: /* pulo incondicional */
2875	{
2876	ni=(l_code *) iadd(ni);
2877	break;
2878	}
2879	case or_op :
2880	case and_op:
2881	{
2882	retrieve_two_logical_operands;
2883	IFERR_GOTO;
2884	if(infoi(ni)==and_op)elem.op.boolean=op1->op.boolean && op2->op.boolean;
2885	if(infoi(ni)==or_op )elem.op.boolean=op1->op.boolean \|\| op2->op.boolean;
2886	push(&elem);
2887	IFERR_GOTO;
2888	ni=(l_code *) next_infoi(ni);
2889	break;
2890	}
2891	case not_op:
2892	{
2893	auxpop = pop(); IFERR_GOTO;
2894	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
2895	is_not_of_class(op1->classe,logical);
2896	IFERR_GOTO;
2897	elem.classe=logical;
2898	elem.op.boolean=!op1->op.boolean ;
2899	push(&elem);
2900	IFERR_GOTO;
2901	ni=(l_code *) next_infoi(ni);
2902	break;
2903	}
2904	case neq_op :
2905	case gtr_op :
2906	case lss_op :
2907	case leq_op :
2908	case geq_op :
2909	case eql_op :
2910	{
2911	instruction=infoi(ni);
2912	retrieve_two_operands ();
2913	IFERR_GOTO;
2914	switch (class_of_the_both)
2915	{
2916
2917	case string :
2918	{
2919	result=strcmp(op1->op.s,op2->op.s);
2920	switch (instruction) {
2921	case neq_op: cond_code= (result != 0)?true:false; break;
2922	case gtr_op: cond_code= (result > 0)?true:false; break;
2923	case lss_op: cond_code= (result < 0)?true:false; break;
2924	case leq_op: cond_code= (result <= 0)?true:false; break;
2925	case geq_op: cond_code= (result >= 0)?true:false; break;
2926	case eql_op: cond_code= (result == 0)?true:false; break;
2927	}
2928	break;
2929	}/* string */
2930	case long_n :
2931	{
2932	switch (instruction) {
2933	case neq_op: cond_code= (long_value_1 != long_value_2 )?true:false; break;
2934	case gtr_op: cond_code= (long_value_1 > long_value_2 )?true:false; break;
2935	case lss_op: cond_code= (long_value_1 < long_value_2 )?true:false; break;
2936	case leq_op: cond_code= (long_value_1 <= long_value_2 )?true:false; break;
2937	case geq_op: cond_code= (long_value_1 >= long_value_2 )?true:false; break;
2938	case eql_op: cond_code= (long_value_1 == long_value_2 )?true:false; break;
2939	}
2940	break;
2941	}/integer /
2942	case float_n :
2943	{
2944	#if DEB_FLOAT
2945	printf("\n Vai comparar (%f) com (%f)",float_value_1,float_value_2);
2946	#endif
2947	switch (instruction) {
2948	case neq_op: cond_code=(float_value_1 != float_value_2)?true:false; break;
2949	case gtr_op: cond_code=(float_value_1 > float_value_2)?true:false; break;
2950	case lss_op: cond_code=(float_value_1 < float_value_2)?true:false; break;
2951	case leq_op: cond_code=(float_value_1 <= float_value_2)?true:false; break;
2952	case geq_op: cond_code=(float_value_1 >= float_value_2)?true:false; break;
2953	case eql_op: cond_code=(float_value_1 == float_value_2)?true:false; break;
2954	}
2955	break;
2956	}/integer /
2957
2958	case integer :
2959
2960	{
2961	switch (instruction) {
2962	case neq_op: cond_code= (int_value_1 != int_value_2 )?true:false; break;
2963	case gtr_op: cond_code= (int_value_1 > int_value_2 )?true:false; break;
2964	case lss_op: cond_code= (int_value_1 < int_value_2 )?true:false; break;
2965	case leq_op: cond_code= (int_value_1 <= int_value_2 )?true:false; break;
2966	case geq_op: cond_code= (int_value_1 >= int_value_2 )?true:false; break;
2967	case eql_op: cond_code= (int_value_1 == int_value_2 )?true:false; break;
2968	}
2969	break;
2970	}/integer /
2971
2972	default:
2973	{
2974	inter_error("Operations for these classes of operands not implemented");
2975	IFERR_GOTO;
2976	}
2977	} /* switch */
2978	elem.classe=logical;
2979	elem.op.boolean=cond_code;
2980	push(&elem);
2981	IFERR_GOTO;
2982	ni=(l_code *) next_infoi(ni);
2983	break;
2984
2985	}
2986	case plus_op :
2987	case minus_op :
2988	case divide_op :
2989	case times_op :
2990	{
2991	instruction=infoi(ni);
2992	retrieve_two_numeric_operands();
2993	IFERR_GOTO;
2994
2995
2996	switch(new_class)
2997	{
2998	case integer:
2999	{
3000	if (instruction==plus_op) tempint=int_value_1 + int_value_2;
3001	if (instruction==minus_op) tempint=int_value_1 - int_value_2;
3002	if (instruction==times_op) tempint=int_value_1 * int_value_2;
3003	if (instruction==divide_op)tempint=int_value_1 / int_value_2;
3004	elem.classe=new_class;
3005	elem.op.i=tempint;
3006	break;
3007	}
3008	case long_n:
3009	{
3010	if (instruction==plus_op) templong=long_value_1 + long_value_2;
3011	if (instruction==minus_op) templong=long_value_1 - long_value_2;
3012	if (instruction==times_op) templong=long_value_1 * long_value_2;
3013	if (instruction==divide_op)templong=long_value_1 / long_value_2;
3014	elem.classe=long_n;
3015	elem.op.l=templong;
3016	break;
3017	}
3018
3019	case float_n:
3020	{
3021	if (instruction==plus_op) tempfloat=float_value_1 + float_value_2;
3022	if (instruction==minus_op) tempfloat=float_value_1 - float_value_2;
3023	if (instruction==times_op) tempfloat=float_value_1 * float_value_2;
3024	if (instruction==divide_op)tempfloat=float_value_1 / float_value_2;
3025
3026	elem.classe=float_n;
3027	elem.op.r=tempfloat;
3028	break;
3029	}
3030
3031	default:
3032	{
3033	inter_error("Operations for these classes of operands not implemented");
3034	IFERR_GOTO;
3035	break;
3036	}
3037	} /* switch */
3038	push(&elem);
3039	IFERR_GOTO;
3040	ni=(l_code *) next_infoi(ni);
3041	break;
3042	}
3043
3044	case x_spac:
3045	{
3046	qty=iadd(ni);
3047	if( (lw_inter-nextcc)>qty ) /* is room */
3048	{
3049	/* repeat_space(out,pout,qty) */
3050	memset(out+pout,' ',qty); pout+=qty;
3051	nextcc=nextcc+qty;
3052	out[pout]=null_char;
3053	}
3054	else
3055	{ /* there's no room */
3056	/A07 new_line(out,pout); /
3057	new_line(out,pout,outsize);
3058	nextcc=1;
3059	}
3060
3061
3062
3063	ni=(l_code *) next_infoi(ni);
3064	break;
3065	}
3066
3067	case c_spac:
3068	{
3069	qty=iadd(ni);
3070	if(qty<=lw_inter)
3071	{
3072
3073	if( nextcc > qty )
3074	{
3075	/A07 new_line(out,pout); /
3076	new_line(out,pout,outsize);
3077	nextcc=1;
3078	}
3079	while (nextcc<qty )
3080	{ out[pout++]=' ';
3081	out[pout]=null_char;
3082	nextcc++;
3083	} /while/
3084	} /* number spaces > lw_inter - ignores the command */
3085	ni=(l_code *) next_infoi(ni);
3086	break;
3087	}
3088
3089	case percent_spac:
3090	{
3091	#if MICRO_ISIS_COMPATIBLE
3092	int nn;
3093	nn=exec_percent(out,&pout,&nextcc);
3094	#endif
3095	ni=(l_code *) next_infoi(ni);
3096	#if MICRO_ISIS_COMPATIBLE
3097	/* se ja existe mudanca de linha e prox instrucao #, ignora-a */
3098	if ( (nn>0) && (infoi(ni)==n_sign_spac) )
3099	ni=(l_code *) next_infoi(ni);
3100	#endif
3101	break;
3102	}
3103
3104	case n_sigx_spac:
3105	/* see case x_spac: */
3106	{
3107	qty=iadd(ni);
3108	while (qty > 0) {
3109	char p,q;
3110	int mlen,hlen,qlen;
3111	mlen=RECnbytes-(MFRmfrl+sizeof(DIRSTRU));
3112	if (mlen <= (hlen=1+6+1+9+1)+2) break;
3113	p=MFX+(MFRmfrl+sizeof(DIRSTRU));
3114	sprintf(p,"H%6ld %9ld ",(LONGX)qty,0L);
3115	q=p+hlen; if (!fgets(q, mlen-hlen, stdin)) break;
3116	qlen=strlen(q); if (!qlen) break;
3117	if (q[--qlen] != '\n') break;
3118	sprintf(p+hlen-(9+1),"%9ld",(LONGX)qlen); p[hlen-1]=' ';
3119	#if CICPP
3120	p=recp->xfldupdat(p);
3121	#else /* CICPP */
3122	p=fldupdat(irec,p);
3123	#endif /* CICPP */
3124	if (p) fatal(p);
3125	qty=0;
3126	}
3127	ni=(l_code *) next_infoi(ni);
3128	break;
3129	}
3130
3131	case n_sign_spac:
3132	{
3133	/A07 new_line(out,pout); /
3134	new_line(out,pout,outsize);
3135	nextcc=1; /* upadtes next position avaialble in line */
3136	ni=(l_code *) next_infoi(ni);
3137	break;
3138	}
3139	case slash_s