Context Navigation

cifm3_unicode.c

Revision 389, 130.3 kB (checked in by heitor.barbieri, 3 weeks ago)
essage first commit

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
134	size_t strlen_UTF8(const char * str);
135	char* skipchar_UTF8(const char * str, int qtt);
136	#else
137
138	float_x convert_to_float();
139	int fmt_type_pattern();
140	int fmt_type_number();
141
142	void fmt_init_E_S();
143	void free_S();
144
145	char *fmt_copy_realloc();
146	char *fmt_alloc_char();
147	int fmt_instr();
148	char *fmt_type();
149	void trace_field(); /* AOT 27/12/91 */
150	LONGX number_of_lines();
151	static void sub_field_string();
152	/* char long_to_char(); substituida /
153	char *trata_md();
154	void upcase_mode();
155	void out_put_str();
156
157	size_t strlen_UTF8();
158	char* skipchar_UTF8();
159	#endif
160	#endif /* CICPP */
161
162	/--------------------------------------------------------------------------/
163	/* global types */
164	/--------------------------------------------------------------------------/
165	#if !CICPP
166	typedef union stack_operands {
167	int i;
168	float_x r;
169	int boolean;
170	char *s;
171	char *address;
172	LONGX l;
173	#if CICPP /ifcmm/
174	RECSTRU *lrecp;
175	#endif /CICPP/ /endcmm/
176	} ustackopnd;
177	typedef struct stack_nodex{
178	enum classe_operandos classe;
179	union stack_operands op;
180
181	}stack_node;
182
183	/* prototypes */
184	#if ANSI
185	int exec_percent(char out,int outs,LONGX *ncc);
186	void retrieve_two_numeric_operands (void);
187	stack_node *pop(void);
188	void inter_error (char *err);
189	void restore_context(void);
190	void push ( stack_node *e);
191	int cast_to_int (stack_node *e);
192	char field_value(char p,LONGX n,int dd);
193	void retrieve_determine_class(void);
194	void take_numeric_operands_value(class_operand new_class);
195	char *sub_string(char source[],int offset,int length);
196	void save_context(int modify_pointers);
197	char store_tmp_string (char str);
198	int is_numeric(class_operand x);
199	void retrieve_two_operands (void);
200	#else
201	int exec_percent();
202	void retrieve_two_numeric_operands ();
203	stack_node *pop();
204	void inter_error();
205	void restore_context();
206	void push ();
207	int cast_to_int ();
208	char *field_value();
209	void retrieve_determine_class();
210	void take_numeric_operands_value();
211	char *sub_string();
212	void save_context();
213	char *store_tmp_string ();
214	int is_numeric();
215	void retrieve_two_operands ();
216	#endif
217	#endif /* CICPP */
218
219
220	/--------------------------------------------------------------------------/
221	/* global_variables */
222	/--------------------------------------------------------------------------/
223	#if !CICPP
224
225	#define max_stack MAXSTACK
226	#define MAX_TMP_STR (MAXMFRL/2)
227	#define MAX_SFIELD (MAXMFRL/2)
228	#define MAX_FD_VALUE (MAXMFRL/2)
229	#define MAX_FD_TMP (MAXMFRL/2)
230
231	LONGX erro_fatal;
232	stack_node stack[max_stack];
233	int stack_pt;
234	stack_node op1_node,op2_node,top_node;
235	stack_node top,elem,op1,op2,auxpop;
236
237	#if DINALLOC
238	//LONGX fmt_fsiz=MAXMFRL; /* fmt_inter() - to set max field length - deslocado para cidbx.c */
239	static LONGX din_fsiz; /* fmt_inter() - current max field length */
240	static char *tmp_str;
241	static LONGX max_tmp_str;
242	static LONGX max_fd_value;
243	static LONGX max_fd_tmp;
244	#else
245	static char tmp_str[MAX_TMP_STR+1];
246	static LONGX max_tmp_str=MAX_TMP_STR;
247	static LONGX max_fd_value=MAX_FD_VALUE;
248	static LONGX max_fd_tmp=MAX_FD_TMP;
249	#endif
250
251	int tmp_str_index;
252	class_operand new_class,class_of_the_both;
253	int result;
254	int cond_code;
255	instruction_code instruction;
256	int tempint;
257	int int_value_1,int_value_2;
258
259	float_x tempfloat,float_value_1,float_value_2 ;
260	LONGX templong ,long_value_1,long_value_2;
261
262	int there_is_fd_value;
263	int there_is_suf;
264	int rep_group;
265	int next_rep_occ;
266	int modify_fmt_pointers=true;
267	int no_modify_fmt_pointers=false;
268
269	#define infoi(i) i->info.instr
270	#define ilab(i) i->info.lab
271	#define iadd(i) i->m_add
272	#define next_infoi(i) i->next
273
274	#define fld_def_ptr(i) i->m_add
275	#define str_const_ptr(i) i->m_add
276
277
278	/* mudar de local para global */
279	char *out;
280	LONGX lw_inter;
281	int pout;
282
283	char address_out,tmp_ptr;
284	LONGX nextcc;
285
286
287	/* incio para achar bug de ref */
288	#if DEBUG_REF
289	int iii;
290	LONGX iix;
291	#endif
292	/* fim para achar bug de ref */
293	/* getc_char */
294	#define get_char /* getchar() */
295	/* 04-02-95 Existia um problema quando havia sufixo e este era
296	colocado no fim de linha e logo apos um crlf.
297	Mesmo o n sendo zero, isto e, nao tendo sido colocado
298	um final do isis padrao pois havia sufixo, por causa
299	do crlf eram retirados 2 caracteres. O crlf so pode
300	ser levado em conta se tiverem sido acrescentados
301	caracteres no final (n>0)
302	*/
303
304	#endif /* CICPP */
305
306	#define delete_chars(out,pout,next,n,lw) \
307	if(n>0) \
308	{ \
309	if(fmt_CRLF(out,pout)) n=n+nl_LEN; /* mudar junto com crlf */ \
310	pout=pout-n; \
311	out[pout]=null_char; \
312	next=next-n; \
313	if(next<1) next=lw-n+1; \
314	} \
315	/--------------------------------------------------------------------------/
316	/* retrieve_two_logical_operands */
317	/--------------------------------------------------------------------------/
318	#define retrieve_two_logical_operands \
319	auxpop = pop(); \
320	if (!fmterror) \
321	{ \
322	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node)); \
323	auxpop = pop(); \
324	if (!fmterror) \
325	{ \
326	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node)); \
327	if (op1->classe!=op2->classe \|\| op1->classe != logical) \
328	inter_error(" Program error two logical operands expected"); \
329	else \
330	elem.classe=logical; \
331	} \
332	}
333
334	/----------------------------------------------------- AOT 27/12/91 -------/
335	/--------------------------------------------------------------------------/
336	/* sc */
337	/* Conversao de strings do tipo "\n" em caracter especial "lf" */
338	/--------------------------------------------------------------------------/
339
340	#if !CICPP
341
342	struct tbc {
343	char s_esp[3];
344	int c_esp;
345	/* } tb_espec[]={"\\r",'R',"\\t",'T',"\\b",'B',"\\n",'N',"\\0",'0'};*/
346	#if BEFORE20000518
347	} tb_espec[]={"\\r",'\r',"\\t",'\t',"\\b",'\b',"\\n",'\n',"\\0",'\0'};
348	#else
349	#if BEFORE20000914
350	} tb_espec[]={{"\\r",'\r'},{"\\t",'\t'},{"\\b",'\b'},{"\\n",'\n'},{"\\0",'\0'}};
351	#else
352	} tb_espec[]={{"\\\r",'\r'},{"\\\t",'\t'},{"\\\b",'\b'},{"\\\n",'\n'},{"\\\0",'\0'}};
353	#endif
354	#endif
355
356	#endif /* CICPP */
357
358
359	#if CICPP
360	void FMTSTRU :: sc(char *pp)
361	#else /* CICPP */
362	#if ANSI
363	void sc(char *pp)
364	#else /* ANSI */
365	void sc(pp)
366	char *pp;
367	#endif /* ANSI */
368	#endif /* CICPP */
369	{
370	char tmp,p,*r;
371	int k;
372	ALLOPARM cte_siz;
373	cte_siz=(ALLOPARM) strlen((char *)pp);
374	tmp=fmt_alloc_char( (ALLOPARM)(cte_siz+1),"cifm2/sc/alloc");
375	/* if (tmp == NULL) IFERR_GOTO; Label ERROR_LABEL is defined at fmt_inter */
376	if (tmp == NULL) fatal("cifm2/sc/alloc/2");
377	strcpy(tmp,pp);
378	p=pp;
379	r=tmp;
380	for (; *tmp ;p++,tmp++) {
381	if (*tmp!='\\') {
382	p=tmp;
383	}else{
384	for (k=0; tb_espec[k].c_esp;k++){
385	#if BEFORE20000914
386	if (strncmp(tb_espec[k].s_esp,(char *)tmp,2)==0) {
387	#else
388	if (strncmp(tb_espec[k].s_esp,(char *)tmp,strlen(tb_espec[k].s_esp))==0) {
389	#endif
390	*p=(char)tb_espec[k].c_esp;
391	tmp++;
392	#if 01
393	#ifndef CICPP
394	printf("\n++ achou\|%s\|", tb_espec[k].s_esp);
395	#endif /* CICPP */
396	#endif
397	break;
398	}
399	}
400	}
401	}
402	*p=null_char;
403	#if 0
404	printf ("\nDentro sc=\|%s\|",q);
405	printf ("\nDentro tmp=\|%s\|",tmp);
406	#endif
407	#if CICPP
408	delete [] r;
409	#else
410	FREE(r);
411	#endif
412
413	}
414
415	/--------------------------------------------------------------------------/
416	/* trace_field */
417	/--------------------------------------------------------------------------/
418	#if CICPP
419	void FMTSTRU :: trace_field(field_definition_node *i,
420	char *p)
421	#else /* CICPP */
422	#if ANSI
423	void trace_field(field_definition_node *i,
424	char *p)
425	#else /ANSI/
426	void trace_field(i,p)
427	field_definition_node *i;
428	char *p;
429	#endif /ANSI/
430	#endif /* CICPP */
431	{
432	int n=0;
433	printf(
434	"#%d[tag=%d,subf=%c,id1=%d,id2=%d,off=%d,len=%d,max=%d,last=%d\n=%s,\n",
435	n,
436	i->tag,
437	i->sub_field,
438	i->indent1,
439	i->indent2,
440	i->offset,
441	i->length,
442	i->max_occ,
443	i->last_occ,p);
444	printf(
445	"act=%d,first=%d\n",
446	i->actual_occ,
447	i->first_occ);
448	}
449
450	/--------------------------------------------------------------------------/
451	/* fmt_type_number */
452	/--------------------------------------------------------------------------/
453	/* type(tipo,formato)
454	tipo =1 alphanumeric
455	tipo =2 alphabetic
456	tipo =3 numeric
457	tipo =4 inteiro decimal. Opcional sinal
458	tipo =5 numero decimal incluindo scientific
459
460	*/
461	#if CICPP
462	int FMTSTRU :: fmt_type_number(int tipo,
463	char *fmt)
464	#else /* CICPP */
465	#if ANSI
466	int fmt_type_number(int tipo,char *fmt)
467	#else
468	int fmt_type_number(tipo,fmt)
469	int tipo;
470	char *fmt;
471	#endif /ANSI/
472	#endif /* CICPP */
473	{ char p,pt_num;
474	int res,a,n,len,scien;
475	res= 0;
476	p=fmt;
477	len=strlen(p);
478	if (len==0) return(1); /* Vazio retorna sempre 1 */
479
480	switch (tipo) {
481	case 1 :
482	case 2 :
483	case 3 :
484	a=0;n=0;
485	while (*p) {
486	if (isiswctab[*p]) a++;
487	if (isdigit(*p)) n++;
488	p++;
489	}
490	if (tipo == 1 && a+n == len) res=1 ;
491	else if (tipo == 2 && a == len) res=1;
492	else if (tipo == 3 && n == len) res=1;
493
494	break;
495	case 4 :
496	case 5 :
497	a=0;
498	scien=0;
499	n=0; /* supor numero inteiro */
500	pt_num=find_numeric_string(p,&a);
501	if ( (strchr(pt_num,'e') != nulo) \|\|
502	(strchr(pt_num,'E') !=nulo ) ) scien=1;
503	if (strchr(pt_num,'.') !=nulo) n=1;
504
505	p=fmt;
506	a=1;
507	while (a) { /* Micro isis aceita espacos `a esqueda */
508	if (p != space_char \|\| p == null_char )a=0;
509	else p++ ;
510	}
511	if ((size_t)strlen(pt_num)==(size_t)strlen(p)){
512	if (tipo==4 && scien == 0 && n==0 ) res=1;
513	else if (tipo == 5) res=1;
514	}
515	break;
516
517	}
518	return(res);
519	}
520	/--------------------------------------------------------------------------/
521	/* fmt_type_pattern */
522	/--------------------------------------------------------------------------/
523	/* Compara um string com um padrao do tipo
524	patt=xx-xx-99-xx-aa
525	str =ca-dd-11-1a-bb
526	Se tamanhos s~ao difentes, entao resultado falso
527	Senao compara caracter a caracter
528	*/
529	#if CICPP
530	int FMTSTRU :: fmt_type_pattern(char *patt,
531	char *fmt)
532	#else /* CICPP */
533	#if ANSI
534	int fmt_type_pattern(char patt,char fmt)
535	#else
536	int fmt_type_pattern(patt,fmt)
537	char *patt;
538	char *fmt;
539	#endif /ANSI/
540	#endif /* CICPP */
541	{ char p,q;
542	int res,l;
543	p=patt; q=fmt; res=1;
544	l=strlen(patt);
545	if (l != strlen(fmt)) return(0);
546	while(res && *p ) {
547	switch ( toupper(*p)) {
548	case 'A' :
549	res = isiswctab[*q];
550	break;
551	case 'X' :
552	res = 1;
553	break;
554	case '9' :
555	if ( !isdigit(*q)) res=0;
556	break;
557	default :
558	res = (q == p);
559	}
560	p++;q++;
561	}
562	return (res);
563
564	}
565	/----------------------------------------------------- AOT 27/12/91 -------/
566	/--------------------------------------------------------------------------/
567	/* fmt_type */
568	/--------------------------------------------------------------------------/
569	/* Usa rotina que separa dentro de um string o proximo numero
570	Se o tamanho do numero separado e igual ao tamanho do string e'porque
571	o string e numerico.
572	Caso contrario verifica se contem apenas letras para ser
573	alfabetico.
574	Caso contrario e alfanumerico
575	*/
576	#if CICPP
577	char * FMTSTRU :: fmt_type(char *p)
578	#else /* CICPP */
579	#if ANSI
580	char fmt_type(char p)
581	#else /ANSI/
582	char *fmt_type(p)
583	char *p;
584	#endif /ANSI/
585	#endif /* CICPP */
586	{
587	static char tmp_ty[2];
588	int i;
589	char q,pt_num;
590	q=p;
591	tmp_ty[1]=null_char;
592	tmp_ty[0]=TY_X;
593	i=0;
594	pt_num=find_numeric_string(p,&i);
595	if ((size_t)strlen(pt_num)==(size_t)strlen(p)){
596	tmp_ty[0]=TY_N;
597	}else{
598	while (isiswctab[q] \|\| q==' ') q++;
599	if (*q==null_char)tmp_ty[0]=TY_A;
600	}
601	/03-11-99 Alterar para retornar '' quando string vazio /
602	if ( (size_t)strlen(p) == (size_t)0 ) tmp_ty[0]=null_char;
603	return (char *)tmp_ty;
604	}
605	/--------------------------------------------------------------------------/
606	/* fmt_init_E_S */
607	/--------------------------------------------------------------------------/
608	#if CICPP
609	void FMTSTRU :: fmt_init_E_S(void)
610	#else /* CICPP */
611	#if ANSI
612	void fmt_init_E_S()
613	#else /ANSI/
614	void fmt_init_E_S()
615	#endif
616	#endif /* CICPP */
617	{ int i;
618	for (i=0;i<NMAXVAR;i++) {
619	E_var[i]= (float_x) 0;
620	S_var[i]= NULL;
621	}
622	}
623	/--------------------------------------------------------------------------/
624	/* fmt_free_S */
625	/--------------------------------------------------------------------------/
626	#if CICPP
627	void FMTSTRU :: fmt_free_S(int from,
628	int to)
629	#else /* CICPP */
630	#if ANSI
631	void fmt_free_S(int from, int to)
632	#else /ANSI/
633	void fmt_free_S(from ,to)
634	int from, to;
635	#endif
636	#endif /* CICPP */
637	{ int i;
638
639	for (i=from;i<=to;i++) {
640
641	if (S_var[i] != NULL)
642	#if 0
643	printf("Lib=[%p]\n", S_var[i]);
644	#endif
645	#if CICPP
646	delete [] (char *)S_var[i];
647	#else /* CICPP */
648	FREE(S_var[i]);
649	#endif /* CICPP */
650	S_var[i]=NULL;
651	}
652	}
653
654
655	/--------------------------------------------------------------------------/
656	/* fmt_copy_realloc */
657	/--------------------------------------------------------------------------/
658	#if CICPP
659	char * FMTSTRU :: fmt_copy_realloc(char *pdest,
660	ALLOPARM *dest_mxlen,
661	char *cte_str)
662	#else /* CICPP */
663	#if ANSI
664	char fmt_copy_realloc(char pdest,ALLOPARM dest_mxlen,char cte_str)
665	#else /ANSI/
666	char *fmt_copy_realloc(pdest,dest_mxlen,cte_str)
667	/Armazena cte_str em pdest /
668	char pdest; /Se necessario realloca pdest para*/
669	ALLOPARM dest_mxlen; /que str_cte caiba e muda tamanho */
670	char cte_str; / max do pdest.Retorna novo endereco*/
671	#endif /ANSI/
672	#endif /* CICPP */
673	{
674	char *p;
675	ALLOPARM cte_siz;
676	cte_siz=(ALLOPARM) strlen((char *)cte_str);
677	if (dest_mxlen<cte_siz){ / realloca string */
678	p=fmt_alloc_char( (ALLOPARM)(cte_siz+1),"cifm3/fmt_realloc");
679	/* if (p == NULL) IFERR_GOTO; Label ERROR_LABEL is defined at fmt_inter */
680	if (p == NULL) fatal("cifm3/fmt_realloc/2");
681	strcpy(p,cte_str);
682	#if CICPP
683	delete [] pdest;
684	#else
685	FREE(pdest);
686	#endif
687
688	*dest_mxlen=cte_siz;
689	return p;
690	}else { /* copia apenas cte_str */
691	strcpy(pdest,cte_str);
692	return pdest; /para efeito de compatibilizar /
693	}
694	}
695	/--------------------------------------------------------------------------/
696	/* fmt_alloc_char */
697	/--------------------------------------------------------------------------/
698
699	#if CICPP
700	char * FMTSTRU :: fmt_alloc_char(ALLOPARM tam,
701	char *msg)
702	#else /* CICPP */
703	#if ANSI
704	char fmt_alloc_char(ALLOPARM tam,char msg)
705	#else /ANSI/
706	char *fmt_alloc_char(tam,msg)
707	ALLOPARM tam;
708	char *msg;
709	#endif /ANSI/
710	#endif /* CICPP */
711	{
712	char *t;
713	#if CICPP
714	try
715	{ t=(char *)new char [(tam)]; }
716	catch (BAD_ALLOC)
717	{ t=(char *)ALLONULL; }
718	#else /* CICPP */
719	t=(char *)ALLOC((ALLOPARM)(tam));
720	#endif /* CICPP */
721	if (t == (char *)ALLONULL) {inter_error(msg); return NULL; }
722	return t;
723	}
724
725
726	/--------------------------------------------------------------------------/
727	/* fmt_instr */
728	/--------------------------------------------------------------------------/
729	#if CICPP
730	int FMTSTRU :: fmt_instr(char *str_source,
731	char *str_sub)
732	#else /* CICPP */
733	#if ANSI
734	int fmt_instr(char str_source,char str_sub)
735	#else /ANSI/
736	int fmt_instr(str_source,str_sub)
737	char str_source,str_sub;
738	#endif /ANSI/
739	#endif /* CICPP */
740	{
741	char p,res;
742	int pos;
743	pos=0;
744	res=NULL;
745	p=str_source;
746	res = strstr(p,str_sub);
747	if (res!=NULL && p!=NULL && str_sub!=NULL ) {
748	if (res && str_sub) {
749	int ll;
750	ll=strlen(str_sub);
751	pos=1;
752	while (memcmp(p,str_sub,ll)!=0) {
753	p = skipchar_UTF8(p, 1); pos++;
754	//p++; pos++;
755	}
756	}
757	}
758	return pos;
759	}
760	/--------------------------------------------------------------------------/
761	/* retrieve_two_numeric_operands */
762	/--------------------------------------------------------------------------/
763	#if CICPP
764	void FMTSTRU :: take_numeric_operands_value(class_operand new_class)
765	#else /* CICPP */
766	#if ANSI
767	void take_numeric_operands_value(class_operand new_class)
768	#else /ANSI/
769	void take_numeric_operands_value(new_class)
770	class_operand new_class;
771	#endif /ANSI/
772	#endif /* CICPP */
773	{
774	int_value_1=0;
775	int_value_2=0;
776	long_value_1=0L;
777	long_value_2=0L;
778	float_value_1=0.0;
779	float_value_2=0.0;
780
781
782	switch(new_class)
783	{ case integer :
784	int_value_1=op1->op.i;
785	int_value_2=op2->op.i;
786	break;
787	case long_n :
788	if(op1->classe==integer) long_value_1=(LONGX) op1->op.i;
789	if(op1->classe==long_n) long_value_1=op1->op.l;
790	if(op2->classe==integer) long_value_2=(LONGX) op2->op.i;
791	if(op2->classe==long_n) long_value_2=op2->op.l;
792	break;
793	case float_n :
794	if(op1->classe==integer) float_value_1=(float) op1->op.i;
795	if(op1->classe==long_n) float_value_1=(float) op1->op.l;
796	if(op1->classe==float_n) float_value_1=op1->op.r;
797	if(op2->classe==integer) float_value_2=(float) op2->op.i;
798	if(op2->classe==long_n) float_value_2=(float) op2->op.l;
799	if(op2->classe==float_n) float_value_2=op2->op.r;
800
801	break;
802
803	}
804	}
805
806	#if CICPP
807	void FMTSTRU :: retrieve_determine_class(void)
808	#else /* CICPP */
809	void retrieve_determine_class()
810	#endif /* CICPP */
811	{
812	auxpop = pop(); IFERR_RET;
813	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
814	auxpop = pop(); IFERR_RET;
815	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
816	if (op1->classe==string && op2->classe==string){new_class=string;}
817	else
818	{ if ( (op1->classe==integer\|\|op1->classe==float_n \|\|
819	op1->classe==long_n
820	) &&
821	(op2->classe==integer \|\| op2->classe==float_n \|\| op2->classe==long_n) )
822	{if (op1->classe == op2->classe)
823	{ new_class=op1->classe ; }
824	else {if (( op1->classe == integer \|\| op1->classe == long_n ) &&
825	(op2->classe == integer \|\| op2->classe == long_n)
826	) new_class=long_n ;
827	else new_class=float_n;
828	}
829	}
830	else
831	{
832	inter_error("Invalid class of operands for aritmetic/string operators");
833	return;
834	}
835	}
836	}
837
838	/-----------------------------------------------------------------------/
839	#if CICPP
840	void FMTSTRU :: retrieve_two_numeric_operands (void)
841	#else /* CICPP */
842	void retrieve_two_numeric_operands ()
843	#endif /* CICPP */
844	{
845	retrieve_determine_class();
846	IFERR_RET;
847	if(new_class==string)
848	{
849	inter_error("Invalid class of operands for aritmetic operators");
850	return;
851	}
852	else take_numeric_operands_value(new_class);
853
854	} /* precedure */
855	/--------------------------------------------------------------------------/
856	/* retrieve_two_operands */
857	/--------------------------------------------------------------------------/
858	#if CICPP
859	void FMTSTRU :: retrieve_two_operands(void)
860	#else /* CICPP */
861	void retrieve_two_operands()
862	#endif /* CICPP */
863	{
864	retrieve_determine_class();
865	IFERR_RET;
866	class_of_the_both=new_class;
867	if (new_class!=string) take_numeric_operands_value(new_class);
868
869	}
870
871
872	/-------------------------------------------------------------------------/
873	/* is_not_of_class */
874	/-------------------------------------------------------------------------/
875	#define is_not_of_class(x,cl) \
876	if(x!=cl) inter_error("Invalid operand class "); \
877
878
879	/--------------------------------------------------------------------------/
880	/* is_numeric */
881	/--------------------------------------------------------------------------/
882
883	#if CICPP
884	int FMTSTRU :: is_numeric(class_operand x)
885	#else /* CICPP */
886	#if ANSI
887	int is_numeric(class_operand x)
888	#else /ANSI/
889	int is_numeric(x)
890	class_operand x;
891	#endif /ANSI/
892	#endif /* CICPP */
893	{
894	if ( !( x==integer \|\| x==float_n \|\| x==long_n) )
895	{ inter_error("Aritmetic operand expected "); }
896	return(1);
897	}
898
899
900	/--------------------------------------------------------------------------/
901	/* convert_to_float */
902	/--------------------------------------------------------------------------/
903	#if CICPP
904	float_x FMTSTRU :: convert_to_float(stack_node *top)
905	#else /* CICPP */
906	#if ANSI
907	float_x convert_to_float(stack_node *top)
908	#else /ANSI/
909	float_x convert_to_float(top)
910	stack_node *top;
911	#endif /ANSI/
912	#endif /* CICPP */
913	{ float_x x;
914	is_numeric(top->classe);
915	if (top->classe == integer) x = (float_x) top->op.i;
916	if (top->classe == float_n) x = (float_x) top->op.r;
917	if (top->classe == long_n) x = (float_x) top->op.l;
918	return (x);
919	}
920
921
922
923	/------------------------------------------------------------------------/
924	/* save_context */
925	/------------------------------------------------------------------------/
926
927	#if CICPP
928	void FMTSTRU :: save_context(int modify_pointers)
929	#else /* CICPP */
930	#if ANSI
931	void save_context(int modify_pointers)
932	#else /ANSI/
933	void save_context(modify_pointers)
934	int modify_pointers;
935	#endif /ANSI/
936	#endif /* CICPP */
937	{
938
939	#if DEB_FLOAT
940	printf("\n++Save_context l_w=%"_LD_" nextcc=%"_LD_" pout=%d \nout=%s\|",
941	lw_inter,nextcc,pout,out);
942	#endif
943	elem.classe=next_cc;
944	elem.op.l=nextcc;
945	push(&elem);
946	IFERR_RET;
947
948	elem.classe=xindex;
949	elem.op.i=pout;
950	push(&elem);
951	IFERR_RET;
952
953	elem.classe=l_w;
954	elem.op.l=lw_inter;
955	push(&elem);
956	IFERR_RET;
957
958	elem.classe=ptr;
959	elem.op.address= &out[0];
960	push(&elem);
961	IFERR_RET;
962
963	/* define new context */
964
965	out= &out[pout];
966	pout=0;
967	#if TRACESINDO
968	address_out=out;
969	#endif
970	/* These pointers must not be modified for the REF function */
971	if (modify_pointers==true)
972	{
973	lw_inter= MAXMFRL; /* no limits/ / aot - svd 8000L */
974	nextcc=1;
975	}
976
977	}
978
979	/--------------------------------------------------------------------------/
980	/* restore_context */
981	/--------------------------------------------------------------------------/
982
983	#if CICPP
984	void FMTSTRU :: restore_context(void)
985	#else /* CICPP */
986	void restore_context()
987	#endif /* CICPP */
988	{
989	#if DEB_FLOAT
990	int i;
991	#endif
992	tmp_ptr= &out[0]; /save old string /
993
994	/restore the context /
995	auxpop = pop(); IFERR_RET;
996	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
997	is_not_of_class(top->classe,ptr);
998	IFERR_RET;
999	out=top->op.address;
1000	address_out=out;
1001
1002	auxpop = pop(); IFERR_RET;
1003	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
1004	is_not_of_class(top->classe,l_w);
1005	IFERR_RET;
1006	lw_inter=top->op.l;
1007
1008	auxpop = pop(); IFERR_RET;
1009	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
1010	is_not_of_class(top->classe,xindex);
1011	if (fmt_error) return;
1012	pout=top->op.i;
1013
1014	auxpop = pop(); IFERR_RET;
1015	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
1016	is_not_of_class(top->classe,next_cc);
1017	IFERR_RET;
1018	nextcc=top->op.l;
1019	#if DEB_FLOAT
1020	printf("\n++Rest_ctext l_w=%"_LD_" nextcc=%"_LD_" pout=%d \nout=%s\|\n",
1021	lw_inter,nextcc,pout,out);
1022
1023	if (pout>5) {
1024	for (i=pout-5;i<=pout;i++)printf("%c",out[i]);
1025	printf("*");
1026	}
1027	#endif
1028
1029	}
1030
1031	/--------------------------------------------------------------------------/
1032	/* sub_string */
1033	/--------------------------------------------------------------------------/
1034	#if CICPP
1035	char * FMTSTRU :: sub_string(char source[],
1036	int offset,
1037	int length)
1038	#else /* CICPP */
1039	#if ANSI
1040	char *sub_string(char source[],
1041	int offset,
1042	int length)
1043	#else /ANSI/
1044	char *sub_string(source,offset,length)
1045	char source[];
1046	int offset;
1047	int length;
1048	#endif /ANSI/
1049	#endif /* CICPP */
1050	{
1051	int fd_len;
1052	char *q;
1053
1054	q=source;
1055
1056	fd_len=strlen(source);
1057	if(offset<0 \|\| length<0) return(q);
1058	if(offset >= fd_len) *q=null_char;
1059	else
1060	{
1061	q= &source[offset];
1062	fd_len=fd_len-offset;
1063	if(fd_len>length)q[length]=null_char;
1064	}
1065	return q;
1066	}
1067
1068	#if !CICPP
1069	static char *retorno;
1070	#endif /* CICPP */
1071
1072
1073	/--------------------------------------------------------------------------/
1074	/* store tmp_string */
1075	/--------------------------------------------------------------------------/
1076	#if CICPP
1077	char * FMTSTRU :: store_tmp_string (char *str)
1078	#else /* CICPP */
1079	#if ANSI
1080	char store_tmp_string (char str)
1081	#else /ANSI/
1082	char *store_tmp_string (str)
1083	char *str;
1084	#endif /ANSI/
1085	#endif /* CICPP */
1086	{
1087	int len;
1088
1089	if (!str) str=""; /* AOT 04/03/97 */
1090	len=strlen(str);
1091	#if DEB_FLOAT
1092	printf("\n--Storetmp str=%s\|\nlen=%d",str,len);
1093	#endif
1094	if(tmp_str_index+len > max_tmp_str)
1095	{
1096	inter_error("No room to store temporary strings - change MAX_TMP_STR");
1097	return NULL;
1098	}
1099	strcpy(&tmp_str[tmp_str_index],str);
1100	retorno= &tmp_str[tmp_str_index];
1101	tmp_str_index += len+1;
1102	return retorno;
1103	}
1104
1105
1106
1107
1108	/--------------------------------------------------------------------------/
1109	/* cast_to_int */
1110	/--------------------------------------------------------------------------/
1111	#if CICPP
1112	int FMTSTRU :: cast_to_int (stack_node *e)
1113	#else /* CICPP */
1114	#if ANSI
1115	int cast_to_int (stack_node *e)
1116	#else /ANSI/
1117	int cast_to_int (e)
1118	stack_node *e;
1119	#endif /ANSI/
1120	#endif /* CICPP */
1121	{int tmp;
1122	if (e->classe == integer) tmp=e->op.i;
1123	if (e->classe == long_n ) tmp=(int )e->op.l;
1124	if (e->classe == float_n) tmp= (int) e->op.r;
1125	return (tmp);
1126	}
1127	/--------------------------------------------------------------------------/
1128	/* push */
1129	/--------------------------------------------------------------------------/
1130	#if CICPP
1131	void FMTSTRU :: push (stack_node *e)
1132	#else /* CICPP */
1133	#if ANSI
1134	void push (stack_node *e)
1135	#else /ANSI/
1136	void push (e)
1137	stack_node *e;
1138	#endif /ANSI/
1139	#endif /* CICPP */
1140	{
1141	stack_pt++;
1142	if(stack_pt >= max_stack) /* AOT - 27/11/91 */
1143	{
1144	inter_error("Stack overflow - expression too complex ");
1145	return;
1146	}
1147	stack[stack_pt].classe=e->classe;
1148	stack[stack_pt].op=e->op;
1149	}
1150
1151	/--------------------------------------------------------------------------/
1152	/* pop */
1153	/--------------------------------------------------------------------------/
1154	#if CICPP
1155	FMTSTRU :: stack_node * FMTSTRU :: pop(void)
1156	#else /* CICPP */
1157	stack_node *pop()
1158	#endif /* CICPP */
1159	{
1160	static stack_node rr;
1161	static stack_node *prr;
1162	prr= &rr;
1163	if(stack_pt<1){inter_error("Stack underflow"); return NULL;}
1164	rr.classe=stack[stack_pt].classe;
1165	rr.op=stack[stack_pt].op;
1166	stack_pt--;
1167	return prr;
1168	}
1169
1170
1171	/--------------------------------------------------------------------------/
1172	/* exec_percent */
1173	/* Applies de % rules to the output string "out" pointed by "outs" */
1174	/* A07 - Rotina com erro: retirava todos os "newline" do fim da linha e */
1175	/* na verdade tem que deixar apenas um */
1176	/* Retorna 0 se nao ficaram caracteres de "muda-linha" */
1177	/* >0 caso contrario */
1178	/--------------------------------------------------------------------------/
1179
1180	#if CICPP
1181	int FMTSTRU :: exec_percent(char *out,
1182	int *outs,
1183	LONGX *ncc)
1184	#else /* CICPP */
1185	#if ANSI
1186	int exec_percent(char *out,
1187	int *outs,
1188	LONGX *ncc)
1189	#else /ANSI/
1190	int exec_percent(out,outs,ncc)
1191	char *out;
1192	int *outs;
1193	LONGX *ncc;
1194	#endif /ANSI/
1195	#endif /* CICPP */
1196	{
1197	int nnl,k,noend;
1198	k= *outs;
1199	noend=true;
1200	nnl=0;
1201
1202	/* Determina quantos "muda_linha existem no string" */
1203	while( noend==true && k>nl_LEN){
1204	noend=fmt_CRLF(out,k);
1205	if (noend==true){
1206	k=k-nl_LEN;
1207	nnl++;
1208	}
1209	} /while/
1210
1211	if (nnl>1) {
1212	#if MICRO_ISIS_COMPATIBLE
1213	/* Retira os nnl-1 "muda-linha" excedentes */
1214	nnl--;
1215	#endif
1216	k=outs-nnlnl_LEN;
1217	out[k]=null_char;
1218	*outs=k;
1219	*ncc=1;
1220	}
1221	return nnl;
1222	#if 0
1223	*outs=k;
1224	/* end string and modify pointer */
1225	/* calculate the lentgh of the last line to set up nextcc */
1226	nnl=1;
1227	while( !fmt_CRLF(out,k) &&k>1)
1228	{ l++;k--;}
1229	*ncc=l;
1230	#endif
1231	} /percent /
1232
1233
1234
1235	/--------------------------------------------------------------------------/
1236	/* trata_md */
1237	/--------------------------------------------------------------------------/
1238
1239	#if CICPP
1240	char * FMTSTRU :: trata_md(instruction_code mode,
1241	char *s,
1242	int *final_added,
1243	char **tofreep)
1244	#else /* CICPP */
1245	#if ANSI
1246	char *trata_md(instruction_code mode,
1247	char *s,
1248	int *final_added,
1249	char **tofreep)
1250	#else /ANSI/
1251	char *trata_md(mode,s,final_added,tofreep)
1252	instruction_code mode;
1253	char *s;
1254	int *final_added;
1255	char **tofreep;
1256	#endif /ANSI/
1257	#endif /* CICPP */
1258	{
1259	char q; / now via ALLOC() */
1260	char *pq;
1261
1262	char c;
1263	int i,j,k,fim,len;
1264	int menor;
1265
1266	*tofreep=NULL;
1267
1268	/* for mpl and mpu modes there's no change in the filling information */
1269
1270	if(mode==mpu_par \|\| mode==mpl_par)
1271	{
1272	return s;
1273	}
1274
1275	if((len=strlen(s))==0) return s;
1276	#if !RETIRAR
1277	Consultar Adalberto/Piva
1278	#if CICPP
1279	try
1280	{ q=(char *)new char [(len+3+9+1)]; }
1281	catch (BAD_ALLOC)
1282	{ q=(char *)ALLONULL; }
1283	#else /* CICPP */
1284	q=(char *)ALLOC((ALLOPARM)(len+3+9+1));
1285	#endif /* CICPP */
1286	if (q == (char *)ALLONULL) {inter_error("trata_md/ALLOC"); return NULL; }
1287	#else
1288	q=fmt_alloc_char((ALLOPARM)(len+3+9+1),"trata_md/ALLOC");
1289	#endif /RETIRAR /
1290
1291	*tofreep=q;
1292
1293	pq=q;
1294	i=0;
1295	j=0;
1296	menor=false;
1297	fim=false;
1298	*final_added=0;
1299	q[0]=null_char;
1300
1301	while (fim==false)
1302	{
1303	#if TRACE_COMP_M
1304	if( s[i]==null_char ) if (fmttrace) printf(" \n achou null no comeco mode");
1305	#endif /* TRACE_COMP_M */
1306	c= s[i];
1307
1308	/* first stores a character into the output; then verifies if the
1309	character had to be stored or must be eliminated */
1310
1311	q[j]=c;
1312	i++;
1313	j++;
1314
1315	if (c==null_char)
1316	{ /* string analisis has finished
1317	for mdu and mdl two blanks and a punctuation mark( if none)
1318	has to be added;
1319	for mhu and mhl nothing is added
1320	*/
1321
1322
1323	if(mode==mhl_par \|\| mode==mhu_par)
1324	{
1325	pq= sub_field_change(pq);
1326	return pq;
1327	}
1328	/* aplica pontuacao */
1329	fim=false;
1330	for (k=j-1;k>=0 && fim==false; k--)
1331	{if(q[k]!=' ') fim=true;}
1332	if( !ispunctuation(q[k]) )
1333	{
1334	*final_added=1;
1335	k++;
1336	q[k]='.';
1337	}
1338	k++;
1339	q[k++]=' ';
1340	q[k++]=' ';
1341	q[k]=null_char;
1342	final_added= final_added+2;
1343	pq= sub_field_change(pq);
1344	return pq;
1345	}
1346
1347	if ((c==equal_char) && (menor==true))
1348	{ /* ignores the string after "="
1349	for the constructions like <100=hundred> */
1350	while (( s[i]!=null_char) && (s[i]!=greater_char)) {
1351	i=i+1;}
1352	/* ignore all chars befor e < */
1353	if (s[i]==greater_char)
1354	{
1355	if (s[i+1]==less_char)
1356	{ q[j-1]=';' ;
1357	q[j]=' ';
1358	j++;
1359	i++;
1360	}
1361	else {
1362	menor=false;
1363	j--;
1364	}
1365	}
1366	else { /* s[i]=null_char. Retira o "=" */
1367	j--;
1368	q[j]=null_char;
1369	fim=true;
1370	fim=false; /* SVD - 25/09/94 Erro Mas Aceita */
1371	}
1372	} /c=eql_char../
1373	else { if (c==less_char)
1374	{ menor=true;
1375	j--;
1376	}
1377	else
1378	{ if (c==greater_char)
1379	{
1380	if (s[i]==less_char)
1381	{ q[j-1]=';';
1382	q[j]=' ';
1383	j++;
1384	i++;
1385	menor=true;
1386	}
1387	else {
1388	j--;
1389	}
1390	}
1391	}
1392	}
1393
1394	}
1395
1396	/* 25-09-94
1397	Esta dando erro quando um string tem no fim uma sequencia do tipo "<x=y"
1398	O MicroIsis assume um ">" e eu estava indicando erro.
1399	Para deixar como ISIS , retorna o string que foi conseguido enquanto
1400	procurava o ">".
1401	( Acho que a parte de tratamento de sequencias "..><.." pelo MicroIsis
1402	esta incoerente com a documentacao .
1403	Nao vou mexer na minha implementacao sem saber qual a implementacao correta
1404	)
1405	E importante notar que se o campo contem ">" ou "<"estes sao sempre
1406	ignorados.
1407
1408	Precisa forcar a colocar a pontuacao e tratamento de subfield.
1409	Para isso basta mudar a condicao de fim=true para fim=false quando
1410	nao achou o ">". Assim forca a repetir o loop e o proximo caracter
1411	a ser tratado e'c=null_char o que vai fazer com que execute a pontuacao
1412
1413	return("rot.c/trata_md/<100=hundred>");
1414	*/
1415
1416	return(s); /* AOT/RP - 21/10/94 (ver com Sindo) */
1417	}
1418
1419
1420	/------------------------------------------------------------------------/
1421	/* sub_field_string */
1422	/------------------------------------------------------------------------/
1423	#if CICPP
1424	void FMTSTRU :: sub_field_string(char *q,
1425	char sub)
1426	#else /* CICPP */
1427	#if ANSI
1428	static void sub_field_string(char *q,char sub)
1429	#else /ANSI/
1430	static void sub_field_string(q,sub)
1431	char *q;
1432	char sub;
1433	#endif /ANSI/
1434	#endif /* CICPP */
1435	{
1436	char ss,p;
1437	char *t,r[3];
1438	int len;
1439
1440	len=strlen(q);
1441
1442	if(len==0) return;
1443
1444	if(sub==subfield_null) return;
1445	#if !RETIRAR
1446	#if CICPP
1447	try
1448	{ ss=(char *)new char [(len+1)]; }
1449	catch (BAD_ALLOC)
1450	{ ss=(char *)ALLONULL; }
1451	#else /* CICPP */
1452	ss=(char *)ALLOC((ALLOPARM)(len+1));
1453	#endif /* CICPP */
1454	if (ss == (char *)ALLONULL) {inter_error("sub_field_string/ALLOC"); return; }
1455	#else
1456	ss=fmt_alloc_char((ALLOPARM)(len+1),"sub_field_string/ALLOC");
1457	#endif
1458	if (ss == (char *)ALLONULL) return;
1459
1460	ss[0]=null_char;
1461	r[0]=SFLDCHR;
1462	r[1]=' ';
1463	r[2]=null_char;
1464	t=q;
1465
1466	if(sub==multiply_char) /* any subfield */
1467	{
1468	if (len >=2 )
1469	{
1470	if (t==SFLDCHR) {t++; t++;} / ignores 2 char " ^char" */
1471	}
1472	/* len < 2 or not SFLDCHR => It is not a field with subfield */
1473	}
1474	else
1475	{ /* search the substring "^char" using upper and lower cases */
1476	r[1]=tolower(sub);
1477	t=strstr(q,r);
1478	if(t==nulo)
1479	{
1480	r[1]=toupper(sub);
1481	t=strstr(q,r);
1482	}
1483
1484	if(t==nulo) {
1485	q[0]=null_char;
1486	#if CICPP /ifcmm/
1487	delete [] ss;
1488	#else /elsecmm/
1489	FREE(ss);
1490	#endif /CICPP/ /endcmm/
1491	return;
1492	}
1493
1494	/* copies the substring from t to the end or until another substring delimiter */
1495	t++;
1496	t++; /* ignores the delimiters */
1497	}
1498
1499	p=ss;
1500	while ( (t!=null_char) && (t!=SFLDCHR) ) {
1501	if (t == '\\') if ((t+1) == SFLDCHR) t++;
1502	if (*t == null_char) break;
1503	p++ = t++;
1504	}
1505
1506	/* string termination */
1507	*p=null_char;
1508	strcpy(q,ss);
1509	#if CICPP
1510	delete [] (char *)ss;
1511	#else /* CICPP */
1512	FREE(ss);
1513	#endif /* CICPP */
1514	return;
1515	}
1516
1517
1518	#if !CICPP
1519
1520	/* rotinas aritmeticas */
1521	static char str_num[30],*pstr_num;
1522	static LONGX ref_mfn_number;
1523	/* end rotinas aritmeticas */
1524
1525	/* f function variables*/
1526	static int min_width;
1527	static int dec_places;
1528	/* end f-function variables */
1529
1530	#if DINALLOC
1531	static char *v_fd_value;
1532	static char *v_fd_tmp;
1533	#else
1534	static char v_fd_value[MAX_FD_VALUE+1];
1535	static char v_fd_tmp[MAX_FD_TMP+1];
1536	#endif
1537
1538	static char fd_value,fd_tmp;
1539
1540	static LONGX lineqtt; /* RPIVA/AOT/HB - 16/11/98 */
1541
1542	#endif /* CICPP */
1543
1544	/* ----------------------------- cifm3h.c --------------------------- */
1545
1546	/------------------------------------------------------------------------/
1547	/* file: cifm3h.c */
1548	/------------------------------------------------------------------------/
1549	#if !CICPP
1550
1551	#define PRT_DBNAME 0
1552	#define DEB_NOCC 0
1553	/* Continue em grupos repetitivos 17-7-94 */
1554	static int continue_rgroup_maxocc;
1555	static int continue_rgroup;
1556	static char cc;
1557	static int pos;
1558	static int fmt_fim;
1559	static int fmt_n_ref;
1560	static int must_repeat;
1561	static l_code *ni;
1562	static l_code rpni; /repf*/
1563	static float_x float_exp_value;
1564	static field_definition_node *itf;
1565	static RECSTRU *recp;
1566	#if !CICPP /if!cmm/
1567	#define MAXREFS 16
1568	static LONGX vprats[MAXREFS];
1569	static int currprat=0;
1570	static LONGX trm_prat;
1571	static LONGX irec;
1572	#endif /CICPP/ /endcmm/
1573	static char *firstdbnp;
1574
1575	#if ANSI
1576	static char *fmt_get_date(int parmdate, LONGX secs0);
1577	static float_x fmt_cnv_to_float(stack_node *top);
1578	static LONGX fmt_cnv_to_long(stack_node *top);
1579	static void fmt_init_vinstr(l_code *pins,int nnested );
1580	static int fmt_load_all_occ(void);
1581	static void fmt_load_next_occ(void);
1582	static void fmt_comum_ref_beg(void);
1583	static void fmt_comum_ref_end(void);
1584	static void fmt_inicio_grupos_vfields(instruction_code instr_inicial,
1585	instruction_code instr_final);
1586	#else
1587	static char *fmt_get_date();
1588	static float_x fmt_cnv_to_float();
1589	static LONGX fmt_cnv_to_long();
1590	static void fmt_init_vinstr();
1591	static int fmt_load_all_occ();
1592	static void fmt_load_next_occ();
1593	static void fmt_comum_ref_beg();
1594	static void fmt_comum_ref_end();
1595	static void fmt_inicio_grupos_vfields();
1596	#endif
1597
1598	#endif /* CICPP */
1599
1600	/* ------------------------field value ----------------------------- */
1601
1602	#if CICPP
1603	char * FMTSTRU :: field_value(char *sfieldvalue,
1604	LONGX max_sfield,
1605	int dd)
1606	#else /* CICPP */
1607	#if ANSI
1608	char field_value(char sfieldvalue,
1609	LONGX max_sfield,
1610	int dd)
1611	#else /ANSI/
1612	char *field_value(sfieldvalue,max_sfield,dd)
1613	char *sfieldvalue;
1614	LONGX max_sfield;
1615	int dd;
1616	#endif /ANSI/
1617	#endif /* CICPP */
1618	{
1619	int slen;
1620
1621	if (dd < 0 \|\| dd >= (int)(MFRnvf) ) {
1622	sfieldvalue[0]=null_char;
1623	if (fmttrace)
1624	printf("field_value - dd=%d tag=undefined '%s'\n",
1625	dd,sfieldvalue);
1626	return (sfieldvalue);
1627	}
1628
1629	slen=DIRlen(dd);
1630
1631	if (slen > max_sfield) {
1632	char *fld = FIELDP(dd);
1633	int slen2 = slen = max_sfield-3;
1634
1635	while(slen2 > 0) {
1636	if (skipchar_UTF8(fld,slen2)>(fld+slen)) {
1637	slen2--;
1638	}
1639	}
1640	memcpy(sfieldvalue,FIELDP(dd),slen2);
1641	sprintf(sfieldvalue+slen2,"+++");
1642	if (fmttrace) printf("%s MAX_SFIELD=%"_LD_"\n",sfieldvalue+slen2,slen2);
1643	}
1644	else {
1645	memcpy(sfieldvalue,FIELDP(dd),slen);
1646	sfieldvalue[slen]='\0';
1647	}
1648	if (fmttrace)
1649	printf("field_value - dd=%d tag=%u '%s'\n",
1650	dd,DIRtag(dd),sfieldvalue);
1651	return (sfieldvalue);
1652	}
1653
1654
1655	/-------------------------------------------------------------------------/
1656	/* fmt_get_date */
1657	/-------------------------------------------------------------------------/
1658	#if CICPP
1659	char * FMTSTRU :: fmt_get_date(int parmdate, LONGX secs0)
1660	#else /* CICPP */
1661	#if ANSI
1662	char *fmt_get_date(int parmdate, LONGX secs0)
1663	#else /ANSI/
1664	char *fmt_get_date(parmdate,secs0)
1665	int parmdate;
1666	LONGX secs0;
1667	#endif /ANSI/
1668	#endif /* CICPP */
1669	{
1670	static char fmt_date[21+1]; /* aaaammdd hhmmss WDAY YDAY */
1671	/* 1234567890123456 7 8 901 */
1672	time_t secs_now;
1673	struct tm *tp;
1674	#if BEFORE20010216
1675	#else
1676	if (secs0 >= 0) {
1677	/*The allowable range of calendar times is Jan 1 1970 00:00:00 to Jan 19 2038 03:14:07.
1678	*/
1679	if (secs0 < 86400) secs0=86400; /* seconds('19700102 000000') */
1680	if (secs0 > 2147408047) secs0=2147408047; /* seconds('20380118 031407') */
1681	secs_now=secs0;
1682	} else
1683	#endif
1684	time(&secs_now);
1685	/*time gives the current time, in seconds, elapsed since 00:00:00 GMT, January 1, 1970,
1686	and stores that value in the location pointed to by timer, provided that timer is not a NULL pointer.
1687	*/
1688	tp=localtime(&secs_now);
1689	/*localtime accepts the address of a value returned by time and returns a pointer to the structure of type tm containing the time elements.
1690	It corrects for the time zone and possible daylight saving time.
1691	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.
1692	*/
1693	switch (parmdate) {
1694	case DATEONLY:
1695	sprintf(fmt_date,"%02d/%02d/%02d",
1696	tp->tm_mday,tp->tm_mon+1,tp->tm_year%100);
1697	break;
1698	case DATETIME:
1699	sprintf(fmt_date,"%02d/%02d/%02d %02d:%02d:%02d",
1700	tp->tm_mday,tp->tm_mon+1,tp->tm_year%100,
1701	tp->tm_hour,tp->tm_min,tp->tm_sec);
1702	break;
1703	case 1: /A11 compatibilidade com microisis /
1704	sprintf(fmt_date,"%02d-%02d-%02d %02d:%02d:%02d",
1705	tp->tm_mon+1,tp->tm_mday,tp->tm_year%100,
1706	tp->tm_hour,tp->tm_min,tp->tm_sec);
1707
1708	break;
1709	case 2:
1710	sprintf(fmt_date,"%02d-%02d-%02d",
1711	tp->tm_mon+1,tp->tm_mday,tp->tm_year%100);
1712	break;
1713	case 3:
1714	sprintf(fmt_date,"%02d:%02d:%02d",
1715	tp->tm_hour,tp->tm_min,tp->tm_sec);
1716	break;
1717	default:
1718	sprintf(fmt_date,"%04d%02d%02d %02d%02d%02d %1d %3d",
1719	1900+tp->tm_year,tp->tm_mon+1,tp->tm_mday,
1720	tp->tm_hour,tp->tm_min,tp->tm_sec,
1721	tp->tm_wday,tp->tm_yday);
1722	}
1723	return (char *)fmt_date;
1724
1725	}
1726	/-------------------------------------------------------------------------/
1727	/* fmt_cnv_to_long */
1728	/-------------------------------------------------------------------------/
1729	#if CICPP
1730	LONGX FMTSTRU :: fmt_cnv_to_long(stack_node *top)
1731	#else /* CICPP */
1732	#if ANSI
1733	LONGX fmt_cnv_to_long(stack_node *top)
1734	#else /ANSI/
1735	LONGX fmt_cnv_to_long(top)
1736	stack_node *top;
1737	#endif /ANSI/
1738	#endif /* CICPP */
1739	{ static LONGX tmp_long;
1740
1741	if (top->classe==long_n) tmp_long=top->op.l;
1742	else
1743	if (top->classe==float_n) tmp_long=(LONGX) top->op.r;
1744	else if(top->classe==integer) tmp_long =(LONGX )top->op.i;
1745	else fatal("fmt_inter/Invalid number type ");
1746	return tmp_long;
1747	}
1748	/-------------------------------------------------------------------------/
1749	/* fmt_cnv_to_float */
1750	/-------------------------------------------------------------------------/
1751	#if CICPP
1752	float_x FMTSTRU :: fmt_cnv_to_float(stack_node *top)
1753	#else /* CICPP */
1754	#if ANSI
1755	float_x fmt_cnv_to_float(stack_node *top)
1756	#else /ANSI/
1757	float_x fmt_cnv_to_float(top)
1758	stack_node *top;
1759	#endif /ANSI/
1760	#endif /* CICPP */
1761	{ static float_x tmp_float;
1762
1763	if (top->classe==long_n) tmp_float=(float_x ) (top->op.l);
1764	else
1765	if (top->classe==float_n) tmp_float=(float_x) top->op.r;
1766	else if(top->classe==integer) tmp_float=(float_x )top->op.i;
1767	else fatal("fmt_inter/Invalid number type ");
1768	return tmp_float;
1769	}
1770
1771	/-------------------------------------------------------------------------/
1772	/* fmt_init_vinstr */
1773	/-------------------------------------------------------------------------/
1774	#if CICPP
1775	void FMTSTRU :: fmt_init_vinstr(l_code *ptr_ins,
1776	int nnested)
1777	#else /* CICPP */
1778	#if ANSI
1779	void fmt_init_vinstr(l_code *ptr_ins,
1780	int nnested)
1781	#else /ANSI/
1782	void fmt_init_vinstr(ptr_ins, nnested )
1783	l_code *ptr_ins;
1784	int nnested;
1785	#endif /ANSI/
1786	#endif /* CICPP */
1787	{
1788	int tmp_occ;
1789	if ( (infoi(ptr_ins)==test_occ) \|\| (infoi(ptr_ins)==load_field_all) \|\|
1790	(infoi(ptr_ins)==absent) \|\| (infoi(ptr_ins)==load_field_occ) \|\|
1791	(infoi(ptr_ins)==present) \|\| (infoi(ptr_ins)==print_field) \|\|
1792	(infoi(ptr_ins)==noccins) )
1793	{ itf=(field_definition_node *) iadd(ptr_ins);
1794	itf->max_occ= -1;
1795	itf->actual_occ=0;
1796	itf->last_occ=0;
1797	itf->first_occ=0;
1798	/* Implementar continue dentro de groupo repetitivo 17-7-94*/
1799	if(nnested==1){
1800	#if CICPP /ifcmm/
1801	tmp_occ=recp->xnocc(itf->tag);
1802	#else /elsecmm/
1803	tmp_occ=nocc(irec,itf->tag);
1804	#endif /CICPP/ /endcmm/
1805	if (tmp_occ>continue_rgroup_maxocc)continue_rgroup_maxocc=tmp_occ;
1806	}
1807	}
1808	}
1809	/-------------------------------------------------------------------------/
1810	/* fmt_inicio_grupos_vfields */
1811	/-------------------------------------------------------------------------/
1812	/*DOC 010:
1813	No inicio de um novo grupo e' necesario guardar o contexto
1814	em que o formato esta sendo executado e inicializar essas
1815	variaveis. Esse contexto e representado pelas variaveis
1816	rep_group
1817	next_rep_occ
1818	must_repeat.
1819	Os contadores das instrucoes que referenciam Fields (Vfields)
1820	devem ser inicializados para permitir repeticao dentro
1821	de repeticao para implementar o novo conceito de fields repetitivos.
1822	O grupo de instrucoes que deve ser inicializado e' delemitado pelas
1823	variaveis (instrucao_inicial, instrucao_final).
1824	No caso de grupo repetitivo a proxima instrucao gerada vai incializar
1825	as variaveis do contexto.
1826	*/
1827	#if CICPP
1828	void FMTSTRU :: fmt_inicio_grupos_vfields(instruction_code instr_inicial,
1829	instruction_code instr_final)
1830	#else /* CICPP */
1831	#if ANSI
1832	void fmt_inicio_grupos_vfields(instruction_code instr_inicial,
1833	instruction_code instr_final)
1834	#else /ANSI/
1835	void fmt_inicio_grupos_vfields(instr_inicial,instr_final)
1836	instruction_code instr_inicial,instr_final;
1837	#endif /ANSI/
1838	#endif /* CICPP */
1839	{
1840	elem.classe=logical;
1841	elem.op.l=rep_group;
1842	push(&elem);
1843	IFERR_RET;
1844	rep_group=false;
1845
1846	elem.classe=integer;
1847	elem.op.i=next_rep_occ;
1848	push(&elem);
1849	IFERR_RET;
1850	next_rep_occ=0;
1851
1852	elem.classe=logical;
1853	elem.op.boolean=must_repeat;
1854	push(&elem);
1855	IFERR_RET;
1856	must_repeat=false;
1857	/* Continue em grupos repetitivos 17-7-94 */
1858
1859	elem.classe=integer;
1860	elem.op.i=continue_rgroup_maxocc;
1861	push(&elem);
1862	IFERR_RET;
1863	continue_rgroup_maxocc=0;
1864	#if TRACE_REPF
1865	printf("\n [Beg_init_rep <push>] rep_goup=%d next_rep_occ=%d",
1866	rep_group,next_rep_occ);
1867	#endif
1868	fmt_fim=false;
1869	fmt_n_ref=1;
1870	/* Continue em grupos repetitivos 17-7-94 */
1871	continue_rgroup_maxocc=0;
1872	rpni=(l_code *)ni->next;
1873	while (fmt_fim==false) {
1874	if(infoi(rpni)==instr_inicial) fmt_n_ref++;
1875	if(infoi(rpni)==instr_final ) fmt_n_ref--;
1876	if(fmt_n_ref==0) fmt_fim=true;
1877	else {
1878	/* Continue em grupos repetitivos 17-7-94 */
1879	/* Inicializa contadores de instrucoes que referenciam fields
1880	para determinar o numero maximo de ocorrencias dos campos
1881	Notar que quando funcionar grupos repetitivos aninhados
1882	so interessam o do primeiro nivel. Para o microsisis
1883	original , esse aninhamento nao e possivel. */
1884	fmt_init_vinstr(rpni,fmt_n_ref);
1885	}
1886	rpni=(l_code *)rpni->next;
1887	}
1888	}
1889	/-------------------------------------------------------------------------/
1890	/* fmt_fim_grupos_vfields */
1891	/-------------------------------------------------------------------------/
1892	#if CICPP
1893	void FMTSTRU :: fmt_fim_grupos_vfields(void)
1894	#else /* CICPP */
1895	void fmt_fim_grupos_vfields()
1896	#endif /* CICPP */
1897	{
1898	/* Implementacao de continue 17-7-94 */
1899	auxpop = pop(); IFERR_RET;
1900	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1901	is_not_of_class(op1->classe,integer);
1902	IFERR_RET;
1903	continue_rgroup_maxocc=op1->op.i ;
1904
1905	auxpop = pop(); IFERR_RET;
1906	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1907	is_not_of_class(op1->classe,logical);
1908	IFERR_RET;
1909	must_repeat=op1->op.boolean ;
1910
1911	auxpop = pop(); IFERR_RET;
1912	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1913	is_not_of_class(op1->classe,integer);
1914	IFERR_RET;
1915	next_rep_occ=op1->op.i ;
1916
1917	auxpop = pop(); IFERR_RET;
1918	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
1919	is_not_of_class(op1->classe,logical);
1920	IFERR_RET;
1921	rep_group=op1->op.boolean ;
1922	}
1923
1924	/-------------------------------------------------------------------------/
1925	/* fmt_load_all_occ */
1926	/-------------------------------------------------------------------------/
1927	#if CICPP
1928	int FMTSTRU :: fmt_load_all_occ(void)
1929	#else /* CICPP */
1930	int fmt_load_all_occ()
1931	#endif /* CICPP */
1932	{
1933	int occ;
1934	occ=0;
1935	*fd_value=null_char;
1936	itf=(field_definition_node *) iadd(ni);
1937	#if CICPP /ifcmm/
1938	itf->max_occ=recp->xnocc(itf->tag);
1939	#else /elsecmm/
1940	itf->max_occ=nocc(irec,itf->tag);
1941	#endif /CICPP/ /endcmm/
1942	/* inicio implementacao [x:y] */
1943	itf->execlower=abs(itf->lower);
1944	itf->execupper=abs(itf->upper);
1945	if (itf->lower==LASTVAL) itf->execlower=itf->max_occ;
1946	if (itf->upper==LASTVAL) itf->execupper=itf->max_occ;
1947	/* fim implementacao [x:y] */
1948	/* we must verify in which occurrences the subfield appears */
1949	while (itf->max_occ > itf->actual_occ ) {
1950	if ( ( itf->actual_occ+1 < itf->execlower) \|\|
1951	( itf->actual_occ+1> itf->execupper) ) {
1952	itf->actual_occ ++;
1953	continue ;
1954	}
1955	*fd_tmp=null_char;
1956	itf->actual_occ++;
1957	#if CICPP /ifcmm/
1958	pos=recp->xfieldx(itf->tag,itf->actual_occ );
1959	#else /elsecmm/
1960	pos=fieldx(irec,itf->tag,itf->actual_occ );
1961	#endif /CICPP/ /endcmm/
1962	field_value(fd_tmp,max_fd_tmp,pos);
1963	#if DEB_NOCC
1964	printf("\n fd_tmp=%s",fd_tmp);
1965	#endif
1966	sub_field_string(fd_tmp,itf->sub_field);
1967	#if !FATRAP
1968	if (fmterror) return -1;
1969	#endif
1970	#if DEB_NOCC
1971	printf("\n fd_tmp=%s",fd_tmp);
1972	#endif
1973	if (itf->offset != -1 && itf->length != -1)
1974	fd_tmp=sub_string(fd_tmp,itf->offset,itf->length);
1975	#if DEB_NOCC
1976	printf("\n fd_tmp=%s",fd_tmp);
1977	#endif
1978	if(strlen(fd_tmp)!=0) {
1979	occ++;
1980	if(itf->first_occ==0) itf->first_occ=itf->actual_occ;
1981	itf->last_occ=itf->actual_occ;
1982	}
1983	strcat(fd_value,fd_tmp);
1984	#if DEB_NOCC
1985	printf("\n fd_value=%s occ=%d",fd_value,occ);
1986	#endif
1987	#if DEB_FLOAT
1988	trace_field(itf,fd_tmp);
1989	trace_field(itf,fd_value);
1990	#endif
1991	}
1992	itf->actual_occ=0;
1993
1994	if (fmttrace) trace_field(itf,fd_tmp); /* AOT 26/12/91 */
1995	return occ;
1996	}
1997	/-------------------------------------------------------------------------/
1998	/* fmt_load_next_occ */
1999	/-------------------------------------------------------------------------/
2000	#if CICPP
2001	void FMTSTRU :: fmt_load_next_occ(void)
2002	#else /* CICPP */
2003	void fmt_load_next_occ()
2004	#endif /* CICPP */
2005	{ /*[:] Para grupo repetitivo pega somente e sempre o limite
2006	inferior da ocorrencia
2007	*/
2008	int occx;
2009	*fd_value=null_char;
2010	occx=itf->actual_occ;
2011	if (rep_group==true && !NO_INTERVAL(itf) ) occx=itf->execlower;
2012	if ( (occx < itf->execlower) \|\| (occx > itf->execupper) ) return;
2013	/[:]/
2014	#if CICPP /ifcmm/
2015	pos=recp->xfieldx(itf->tag,occx);
2016	#else /elsecmm/
2017	pos=fieldx(irec,itf->tag,occx);
2018	#endif /CICPP/ /endcmm/
2019	field_value(fd_value,max_fd_value,pos);
2020	/* subfields */
2021	cc=itf->sub_field;
2022	if (cc!=subfield_null){
2023	sub_field_string(fd_value,cc);
2024	IFERR_RET;
2025	}
2026	/substring/
2027	if(itf->offset!= -1 && itf->length!= -1)
2028	strcpy(fd_value,sub_string(fd_value,itf->offset,itf->length));
2029	}
2030	/-------------------------------------------------------------------------/
2031	/* fmt_comum_ref_beg */
2032	/-------------------------------------------------------------------------/
2033	#if CICPP /ifcmm/
2034	void FMTSTRU :: fmt_comum_ref_beg(void)
2035	{
2036	try { recp=new RECSTRU(cisisxp); }
2037	catch (BAD_ALLOC) { fatal("fmt/inter/refrec/ALLOC"); }
2038	recp->xrecalloc(MAXMFRL); /* p/ manter check: pode nao usar */
2039	/* recp is global */
2040	}
2041	#else /elsecmm/
2042	void fmt_comum_ref_beg()
2043	{
2044	if (currprat >= MAXREFS) fatal("fmt/inter/refrec/MAXREFS");
2045	if (!nrecs) fatal("fmt/inter/refrec/recinit");
2046	for (irec=maxnrec; irec--; )
2047	if (!vrecp[irec]) /* ja' decrementado */ break;
2048	if (irec < 0) fatal("fmt/inter/refrec/next");
2049	currprat++;
2050	vprats[currprat]=irec;
2051	recallok(irec,MAXMFRL); /* p/ manter check: pode nao usar */
2052	recp=vrecp[irec]; /* mandatory for defines REC RDB MF0 MFR DIR, FIELDP */
2053	}
2054	#endif /CICPP/ /endcmm/
2055	/-------------------------------------------------------------------------/
2056	/* fmt_comum_ref_end */
2057	/-------------------------------------------------------------------------/
2058	#if CICPP /ifcmm/
2059	void FMTSTRU :: fmt_comum_ref_end(void)
2060	{
2061	auxpop = pop(); IFERR_RET;
2062	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2063	is_not_of_class(top->classe,type_recstru);
2064	IFERR_RET;
2065	#if BEFORE990414
2066	// nao liberava nada! - AOT/HB
2067	#else
2068	if (ref_mfn_number>0){
2069	delete recp;
2070	}
2071	#endif
2072	recp=top->op.lrecp;
2073	}
2074	#else /elsecmm/
2075	void fmt_comum_ref_end()
2076	{
2077	LONGX trec;
2078	auxpop = pop(); IFERR_RET;
2079	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2080	is_not_of_class(top->classe,long_n);
2081	IFERR_RET;
2082	trec=top->op.l;
2083	/* A alocacao so foi feita se foi gerado mfn valido(>0) pelo ref */
2084	if (ref_mfn_number>0){
2085	/* recp=vrecp[trec];/ / e' necessario? / / YES */
2086	if (currprat < 0 \|\| !vrecp[vprats[currprat]]) fatal("fmt/inter/refrec/free");
2087	irec=vprats[currprat];
2088	FREE(vrecp[irec]); vrecp[irec]=NULL; nrecs--;
2089	currprat--; /Posiciona na prateleira anterior /
2090
2091	/* irec=vprats[currprat];*/
2092	}
2093	irec=trec;
2094	recp=vrecp[irec];/* mandatory for defines REC RDB MF0 MFR DIR, FIELDP */
2095	}
2096	#endif /* CICPP / /endcmm*/
2097
2098	/----------- inter --------------------------------------/
2099	#if CICPP
2100	LONGX FMTSTRU :: xfmt_inter(RECSTRU *parmrecp,
2101	LONGX par_lw,
2102	char *par_out,
2103	LONGX outsize)
2104	#else /* CICPP */
2105	LONGX fmt_inter(pgm,parmirec,par_lw,par_out,outsize)
2106	l_code *pgm;
2107	LONGX parmirec;
2108	LONGX par_lw;
2109	char *par_out;
2110	LONGX outsize;
2111	#endif /* CICPP */
2112	{
2113	char v_mfn_str[20],*mfn_str;
2114	/A06/
2115	/* char literal[MAX_LITER+1]; virou dinamico e global*/
2116	char *new_dbname;
2117	instruction_code actual_mode;
2118	int fim_pgm;
2119	int i;
2120	/* para colocar string na saida */
2121	char pre_literal,suf_literal,nothing;
2122	char *s;
2123	int id1;
2124	int id2;
2125	int final_added;
2126	LONGX qty;
2127	instruction_code next_ins;
2128	l_code *next_ni;
2129	#if DINALLOC
2130	int xdir;
2131	LONGX xfsiz;
2132	#endif
2133
2134	if (!ndbxs) dbxinit(); /* init vdbxp/vrecp/vtrmp if not yet init - AOT, 28/10/2005 */
2135
2136	#if CICPP
2137	l_code *pgm = fmt_pgmp;
2138	#endif /* CICPP */
2139	/--------------------------------------------------------------------------/
2140	/* NewLine-Valor default */
2141	/--------------------------------------------------------------------------/
2142	/* A07*/
2143
2144	#if UNIX \| WWWISIS
2145	nl_LEN=1;
2146	nl_STR=fmt_alloc_char((ALLOPARM)(nl_LEN+1),"cifm3/alloc/nl_STR");
2147	nl_STR[0]=lf; nl_STR[1]=null_char;
2148	#else
2149	nl_LEN=2;
2150	nl_STR=fmt_alloc_char((ALLOPARM)(nl_LEN+1),"cifm3/alloc/nl_STR");
2151	nl_STR[0]=cr; nl_STR[1]=lf; nl_STR[2]=null_char;
2152	#endif
2153	if (fmttrace) printf("+++ fmt_inter - begin \n"); /* AOT 27/12/91 */
2154	strcpy(fmterrxy,"");
2155	#if FATRAP
2156	fmterror = setjmp(fmtjumper);
2157	#else /* FATRAP */
2158	fmterror = 0;
2159	ERROR_LABEL:
2160	#endif /* FATRAP */
2161	if (fmterror != 0) {
2162	return((fmterror < 0) ? (LONGX)fmterror : (LONGX)(-fmterror));
2163	}
2164
2165	if (par_lw <= 0) par_lw=MAXMFRL-1; /* AOT, 07/06/2005 */
2166	if (par_lw >= outsize) par_lw=outsize-1; /* AOT, 07/06/2005 */
2167
2168	/* set current master file record */
2169	#if CICPP /ifcmm/
2170	recp=parmrecp;
2171	#else /elsecmm/
2172	irec=parmirec;
2173	recp=vrecp[irec];
2174	vprats[currprat]=irec;
2175	#endif /CICPP/ /endcmm/
2176
2177	firstdbnp=RDBname;
2178
2179	/* Alocacao das maiores areas originalmente estaticas - AOT 29/12/90 */
2180	#if DINALLOC
2181	max_tmp_str=outsize; /* parm asize */
2182	#if !RETIRAR
2183	#if CICPP
2184	try
2185	{ tmp_str= (char *)new char [(max_tmp_str+1)]; }
2186	catch (BAD_ALLOC)
2187	{ tmp_str= (char *) NULL; }
2188	#else /* CICPP */
2189	tmp_str=(char *)ALLOC((ALLOPARM)(max_tmp_str+1));
2190	#endif /* CICPP */
2191	#else /RETIRAR /
2192	tmp_str=fmt_alloc_char((ALLOPARM)(max_tmp_str+1),"1001");
2193	#endif /RETIRAR /
2194	if (tmp_str == NULL)
2195	{
2196	#if !RETIRAR
2197	inter_error("1001");
2198	#endif
2199	IFERR_GOTO;
2200	}
2201	/A06/
2202	literal_len =(ALLOPARM)MAX_LITER;
2203	literal=fmt_alloc_char((ALLOPARM)(literal_len+1),"cifm3/alloc/literal");
2204	if (literal == NULL) IFERR_GOTO;
2205
2206	if (fmt_fsiz) {
2207	max_fd_value=fmt_fsiz;
2208	max_fd_tmp=fmt_fsiz;
2209	}
2210	else {
2211	for (xdir=MFRnvf, din_fsiz=0; xdir--; )
2212	if (DIRlen(xdir) > din_fsiz) din_fsiz=DIRlen(xdir);
2213	if (fmttrace) printf("+++ fmt_inter - din_fsiz=%"_LD_"\n",din_fsiz);
2214	if (din_fsiz < par_lw) din_fsiz=par_lw; /* bug lw=999 */
2215	if (fmttrace) printf("+++ fmt_inter - din_fsiz=%"_LD_"\n",din_fsiz);
2216	max_fd_value=din_fsiz;
2217	max_fd_tmp=din_fsiz;
2218	}
2219
2220	#if CICPP
2221	try
2222	{ v_fd_value= (char *) new char [(max_fd_value+1)]; }
2223	catch (BAD_ALLOC)
2224	{ v_fd_value= NULL; }
2225	#else /* CICPP */
2226	v_fd_value= (char *)ALLOC((ALLOPARM)(max_fd_value+1));
2227	#endif /* CICPP */
2228	if (v_fd_value==(char *)NULL)
2229	{
2230	inter_error("1003");
2231	IFERR_GOTO;
2232	}
2233	#if CICPP
2234	try
2235	{ v_fd_tmp= (char *) new char [(max_fd_tmp+1)]; }
2236	catch (BAD_ALLOC)
2237	{ v_fd_tmp= (char *) NULL;}
2238	#else /* CICPP */
2239	v_fd_tmp= (char *)ALLOC((ALLOPARM)(max_fd_tmp+1));
2240	#endif /* CICPP */
2241	if (v_fd_tmp== (char *)NULL)
2242	{
2243	inter_error("1004");
2244	IFERR_GOTO;
2245	}
2246	#endif
2247
2248	/* Sindo's code */
2249	continue_rgroup_maxocc=0;
2250	continue_rgroup=false;
2251
2252	/* Inicializacao do stack[] - AOT 27/11/91 */
2253	stack_pt=0; /* push() e pop() usam a partir de 1 - comunicar */
2254
2255	op1= &op1_node;
2256	op2= &op2_node;
2257	top= &top_node;
2258	out= &par_out[0];
2259	lw_inter=par_lw;
2260
2261	/* incializacoes */
2262	fd_value=v_fd_value; /* DINALLOC */
2263	mfn_str=v_mfn_str;
2264	must_repeat=false;
2265	rep_group=false;
2266	next_rep_occ=0;
2267	pstr_num=str_num;
2268
2269	nextcc=1;
2270	tmp_str_index=0;
2271	nothing=null_char;
2272	pre_literal= &nothing;
2273	suf_literal= &nothing;
2274	erro_fatal=0;
2275
2276	out[0]=null_char;
2277	pout= 0;
2278	address_out=out;
2279
2280	/* defaults */
2281
2282	actual_mode=mpl_par;
2283	final_added=0;
2284
2285	fim_pgm= ~false;
2286	if (pgm)
2287	if (pgm->next) {
2288	/* inicializa A tabela de definicao de fields */
2289	ni=(l_code )pgm->next; / next instruction */
2290	for (;next_infoi(ni)!=(int)nulo;){
2291	fmt_init_vinstr(ni,0);
2292	ni=(l_code *)ni->next;
2293	}
2294	fim_pgm=false;
2295	ni=(l_code )pgm->next; / next intruction */
2296	}
2297
2298	/* 22/10/99 Inicializa as variaveis E e S */
2299	fmt_init_E_S();
2300
2301
2302	while (fim_pgm==false){
2303	fd_tmp=v_fd_tmp;
2304
2305	#if TRACE_INTER_X
2306	if (fmttrace)
2307	printf(" #%d[%d,%s,%d]\n",0,ni->info.lab,
2308	inst_cnv[ni->info.instr], ni->info.add);
2309	#endif /* TRACE_INTER_X */
2310	#if DEBUG_REF
2311	printf("\n #%d[%d,%s,%d]\n",0,ni->info.lab,
2312	inst_cnv[ni->info.instr], ni->info.add);
2313
2314	printf("\n---- ESTADO da pilha ----- termos %d \n",ntrms);
2315	for (iii=stack_pt;iii>0;iii--) {
2316	printf("\n %d %d %d ",iii,stack[iii].classe, stack[iii].op);
2317	if (stack[iii].classe==string) printf(" string");
2318	if (stack[iii].classe==long_n) printf(" long_n %"_LD_" ",stack[iii].op.l);
2319	if (stack[iii].classe==integer) printf(" integer");
2320	if (stack[iii].classe==float_n) printf(" float_n ");
2321	if (stack[iii].classe==logical) printf(" logical %d ",stack[iii].op.i);
2322	if (stack[iii].classe==ptr) printf(" ptr %"_LD_" (%p)",
2323	stack[iii].op.address,stack[iii].op.address);
2324	if (stack[iii].classe==l_w) printf(" l_w =%"_LD_" ",stack[iii].op.l);
2325	if (stack[iii].classe==xindex) printf(" index %d ",stack[iii].op.i);
2326	if (stack[iii].classe==next_cc) printf(" next_cc %"_LD_,stack[iii].op.l);
2327
2328	}
2329	#if 0
2330	printf("\n ---- Alocacoes invertido --- ntrms=%d",
2331	ntrms);
2332	for (iix=maxntrm; iix>=trm_prat; iix--) {
2333	printf ("\n vtrmp[%"_LD_"]= %"_LD_" (%p )", iix,vtrmp[iix],vtrmp[iix]);
2334	}
2335	#endif
2336	#endif
2337	/loop/
2338	switch(infoi(ni))
2339	{
2340	case test_occ:
2341	{
2342	itf=(field_definition_node *) iadd(ni);
2343	there_is_fd_value=false;
2344	fd_value=null_char; / 08/05/92 */
2345	fd_tmp=null_char; / 08/05/92 */
2346	if (itf->max_occ == -1)
2347	{ fmt_load_all_occ(); IFERR_GOTO; }
2348
2349	if(rep_group==true)itf->actual_occ=next_rep_occ;
2350	else itf->actual_occ++;
2351	/* Tentativa de Implementar v70[1] dentro de repetitivo */
2352	/* 30-12-94 */
2353	if (rep_group==true && !NO_INTERVAL(itf)) {
2354	/* Intervalo dentro de repetitivo so pega o lower
2355	O comando abaixo forca o valor de itf->actual_occ
2356	somente com o objetivo de entrar no proximo teste,
2357	pois de qualquer forma o numero da ocorrencia sera
2358	aquele especificado no lower.
2359	Esta implementacao e muito suja. No caso de um
2360	formato do tipo ( v70[2],c20,v26[3]) se nocc(70)=5
2361	serao geradas 5 linhas iguais !!!!
2362	*/
2363	itf->actual_occ=itf->max_occ;
2364	}
2365
2366	if (itf->max_occ >= itf->actual_occ){
2367	there_is_fd_value=false;
2368	elem.classe=logical;
2369	elem.op.boolean=true;
2370	fmt_load_next_occ();
2371	IFERR_GOTO;
2372	if(strlen(fd_value)!=0)there_is_fd_value=true;
2373
2374	if (fmttrace) trace_field(itf,fd_value);/* AOT 26/12/91 */
2375	}
2376	else {
2377	*fd_value=null_char;
2378	elem.classe=logical;
2379	elem.op.boolean=false;
2380	if (fmttrace) trace_field(itf,""); /* AOT 26/12/91 */
2381	}
2382
2383	push(&elem);
2384	IFERR_GOTO;
2385	ni=(l_code ) next_infoi(ni); / proxima instrucao */
2386	break;
2387	}
2388	case suf_cond :
2389	case suf_cond_null :
2390	case suf_r_lit :
2391	case suf_r_lit_plus :
2392	{
2393	ni=(l_code *) next_infoi(ni);
2394	break;
2395	}
2396
2397	case ign_cond :
2398	{
2399	there_is_fd_value=false;
2400	ni=(l_code *) next_infoi(ni);
2401	break;
2402	}
2403
2404	case pre_cond :
2405	{
2406	if (there_is_fd_value==true)
2407	{
2408	if(itf->actual_occ==itf->first_occ)
2409	{
2410	literal[0]=null_char;
2411	#if !RETIRAR
2412	strcpy(literal, (char *) iadd(ni) );
2413	#else
2414	literal=fmt_copy_realloc((char *)literal, &literal_len,
2415	(char *)iadd(ni));
2416	#endif
2417	if(is_upper_mode(actual_mode)) upcase_mode(literal);
2418	id1=0;
2419	id2=0;
2420	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2421	} /* actual_occ=... */
2422	}
2423
2424	ni=(l_code *) next_infoi(ni);
2425	break;
2426	}
2427
2428	case pre_r_lit_plus :
2429	{
2430	pre_literal= &nothing;
2431
2432	if(itf->actual_occ!=itf->first_occ && there_is_fd_value==true)
2433	{
2434	pre_literal=(char *) iadd(ni);
2435
2436	} /* actual_occ=... */
2437	ni=(l_code *) next_infoi(ni);
2438	break;
2439	}
2440
2441	case pre_r_lit :
2442	{
2443
2444	if(there_is_fd_value==true) pre_literal=(char *) iadd(ni);
2445	ni=(l_code *) next_infoi(ni);
2446	break;
2447	}
2448
2449
2450	case u_cond :
2451	{ /A06/
2452
2453	/* literal[0]=null_char;
2454	strcpy(literal,(char *) iadd(ni) );
2455	*/
2456	literal=fmt_copy_realloc((char *)literal, &literal_len,
2457	(char *)iadd(ni));
2458	if(is_upper_mode(actual_mode)) upcase_mode(literal);
2459	id1=0;
2460	id2=0;
2461	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2462	ni=(l_code *) next_infoi(ni);
2463	break;
2464	}
2465
2466	case escape_seq :
2467	{
2468	literal[0]=(char)27; /escape sequence /
2469	literal[1]=null_char;
2470	/A06/
2471	id1=0;
2472	id2=0;
2473	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2474
2475	/* A06 strcat(literal, (char *) iadd(ni) );
2476	*/
2477	literal=fmt_copy_realloc((char *)literal, &literal_len,
2478	(char *)iadd(ni));
2479	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,literal);
2480	ni=(l_code *) next_infoi(ni);
2481	break;
2482
2483	}
2484	case fmt_beg:
2485	{
2486	save_context(modify_fmt_pointers);
2487	IFERR_GOTO;
2488	ni=(l_code *) next_infoi(ni);
2489	break;
2490	}
2491
2492	case fmt_end:
2493	{
2494
2495
2496	ni=(l_code *) next_infoi(ni);
2497
2498	break;
2499	}
2500	case print_mfn :
2501	{
2502	/* strcpy(mfn_str,long_to_char(MFRmfn,(int )iadd(ni)) );*/
2503	float_exp_value= (float_x ) MFRmfn;
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_maxmfn :
2514	{
2515	float_exp_value= (float_x ) 0;
2516	if (RECdbxp) float_exp_value= (float_x ) RDBmsmfn; /* il fault faire.. */
2517	strcpy((char *)mfn_str,
2518	fmt_float_numb(float_exp_value,(int )iadd(ni) ,(int) 0,'0'));
2519	id1=0;
2520	id2=0;
2521	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,mfn_str);
2522	ni=(l_code *) next_infoi(ni);
2523	break;
2524	}
2525
2526	case print_core :
2527	{
2528	#if CICPP
2529	float_exp_value= (float_x ) 0;
2530	#else /* CICPP */
2531	float_exp_value= (float_x ) CORELEFT();
2532	#endif /* CICPP */
2533	strcpy((char *)mfn_str,
2534	fmt_float_numb(float_exp_value,(int )iadd(ni) ,(int) 0,'0'));
2535	id1=0;
2536	id2=0;
2537	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,mfn_str);
2538	ni=(l_code *) next_infoi(ni);
2539	break;
2540	}
2541
2542	case print_field:
2543	{
2544	char *tofree;
2545
2546	if(itf->max_occ>itf->actual_occ) must_repeat=true;
2547	if (there_is_fd_value==true)
2548	{
2549	*fd_tmp=null_char;
2550	strcpy(fd_tmp,pre_literal);
2551	strcat(fd_tmp,fd_value);
2552	/* exec_suf_literal; */
2553	next_ni=(l_code )next_infoi(ni); / precisa ver 1 passo a frente*/
2554	next_ins=infoi(next_ni);
2555	there_is_suf=false;
2556
2557	if (next_ins==suf_r_lit )
2558	{
2559	ni=(l_code *) next_infoi(ni);
2560	suf_literal=(char *) iadd(ni);
2561	there_is_suf=true;
2562	}
2563
2564	next_ni=(l_code )next_infoi(ni); / precisa ver 1 passo a frente*/
2565	next_ins=infoi(next_ni);
2566
2567	if (next_ins==suf_r_lit_plus)
2568	{ ni=(l_code *) next_infoi(ni);
2569	/* ignores the last occurrence */
2570	if(itf->actual_occ!=itf->last_occ)
2571	{
2572	suf_literal= (char *) iadd(ni);
2573	there_is_suf=true;
2574	}
2575	}
2576	strcat(fd_tmp,suf_literal);
2577	literal[0]=null_char;
2578	next_ni=(l_code )next_infoi(ni); / precisa ver 1 passo a frente*/
2579	next_ins=infoi(next_ni);
2580
2581	if (next_ins==suf_cond_null \|\| next_ins==suf_cond)
2582	{ ni=(l_code *) next_infoi(ni);
2583	if(itf->actual_occ==itf->last_occ )
2584	{
2585	/A06 strcpy(literal, (char ) iadd(ni) );
2586	*/
2587	literal=fmt_copy_realloc((char *)literal, &literal_len,
2588	(char *)iadd(ni));
2589	there_is_suf=true;
2590	} /* else ignores command */
2591	} /* suf_cond */
2592	strcat(fd_tmp,literal);
2593	s=trata_md(actual_mode,fd_tmp,&final_added,&tofree);
2594	IFERR_GOTO;
2595	if(is_upper_mode(actual_mode)) upcase_mode(s);
2596	id1=itf->indent1;
2597	id2=itf->indent2;
2598	out_put_str(out,outsize, &pout,lw_inter,id1,id2, &nextcc,s);
2599	if (tofree) {
2600
2601	#if CICPP
2602	delete [] (char *)tofree;
2603	#else /* CICPP */
2604	FREE(tofree);
2605	#endif /* CICPP */
2606
2607	}
2608	if(there_is_suf==true)
2609	{
2610	delete_chars(out,pout,nextcc,final_added,lw_inter);
2611	}
2612
2613	}
2614	pre_literal= &nothing;
2615	suf_literal= &nothing;
2616	ni=(l_code *) next_infoi(ni);
2617	break;
2618
2619	}
2620
2621	case load_field_all:
2622	{
2623	fmt_load_all_occ();
2624	IFERR_GOTO;
2625	#if TRACE_INTER_2
2626	printf("\n Apos fmt_load_all_occ/1 fd_value=%s",fd_value);
2627	#endif
2628	/* copia para temporaria */
2629
2630	elem.op.s=store_tmp_string(fd_value);
2631	IFERR_GOTO;
2632	elem.classe=string;
2633	push(&elem);
2634	IFERR_GOTO;
2635	ni=(l_code *) next_infoi(ni);
2636	break;
2637	}
2638	case load_field_occ:
2639	{
2640	itf=(field_definition_node *)iadd(ni);
2641	if( itf->max_occ == -1)
2642	{
2643	#if CICPP /ifcmm/
2644	itf->max_occ=recp->xnocc(itf->tag);
2645	#else /elsecmm/
2646	itf->max_occ=nocc(irec,itf->tag);
2647	#endif /CICPP/ /endcmm/
2648	itf->execlower=abs(itf->lower);
2649	itf->execupper=abs(itf->upper);
2650	if (itf->lower==LASTVAL) itf->execlower=itf->max_occ;
2651	if (itf->upper==LASTVAL) itf->execupper=itf->max_occ;
2652	/* fim implementacao [x:y] */
2653
2654	itf->actual_occ=0;
2655	}
2656	*fd_value=null_char;
2657	if (rep_group==true)itf->actual_occ=next_rep_occ;
2658	else itf->actual_occ++;
2659
2660	if (itf->max_occ > itf->actual_occ) must_repeat=true; /* SVD 11/11/91 */
2661
2662	if (itf->max_occ >= itf->actual_occ \|\| !NO_INTERVAL(itf)){
2663	*fd_value=null_char;
2664	fmt_load_next_occ();
2665	IFERR_GOTO;
2666	}
2667
2668	elem.op.s=store_tmp_string(fd_value);
2669	IFERR_GOTO;
2670	elem.classe=string;
2671	push(&elem);
2672	IFERR_GOTO;
2673	ni=(l_code *) next_infoi(ni);
2674	break;
2675	}
2676
2677	case load_string:
2678	{
2679	elem.op.s=(char *) iadd(ni);
2680	elem.classe=string;
2681	push(&elem);
2682	IFERR_GOTO;
2683	ni=(l_code *) next_infoi(ni);
2684	break;
2685	}
2686	case load_mstnam:
2687	{
2688	tmp_ptr=store_tmp_string(RDBname);
2689	IFERR_GOTO;
2690	if(is_upper_mode(actual_mode)) upcase_mode(tmp_ptr);
2691
2692	elem.op.s=tmp_ptr;
2693	elem.classe=string;
2694	push(&elem);
2695	IFERR_GOTO;
2696	ni=(l_code *) next_infoi(ni);
2697	break;
2698	}
2699	case load_date:
2700	{
2701	char *tmp_ptr;
2702	int parmdate;
2703	parmdate=(int)iadd(ni);
2704
2705	tmp_ptr=fmt_get_date(parmdate,-1L);
2706	if(is_upper_mode(actual_mode)) upcase_mode(tmp_ptr);
2707
2708	elem.op.s=store_tmp_string(tmp_ptr);
2709	IFERR_GOTO;
2710	elem.classe=string;
2711	push(&elem);
2712	IFERR_GOTO;
2713	ni=(l_code *) next_infoi(ni);
2714	break;
2715	}
2716	case load_number:
2717	{ /* Only implemented for LONGX numbers */
2718	elem.op.l=(LONGX)iadd(ni);
2719	elem.classe=long_n;
2720	push(&elem);
2721	IFERR_GOTO;
2722	ni=(l_code *) next_infoi(ni);
2723	break;
2724	}
2725	case intvvalue:
2726	{ /* Only implemented for LONGX numbers */
2727	elem.op.r=E_var[(LONGX)iadd(ni)];
2728	elem.classe=float_n;
2729	push(&elem);
2730	IFERR_GOTO;
2731	ni=(l_code *) next_infoi(ni);
2732	break;
2733	}
2734	case load_float:
2735	{
2736	elem.op.r= (float_x )(iadd(ni)) ;
2737	#if DEB_FLOAT
2738	printf("\n Empilhando float=%f",elem.op.r);
2739	#endif
2740	elem.classe=float_n;
2741	push(&elem);
2742	IFERR_GOTO;
2743	ni=(l_code *) next_infoi(ni);
2744	break;
2745	}
2746	case load_mfn:
2747	{ /* tamanho de caracteres sao ignorados */
2748	elem.op.l=(LONGX)MFRmfn;
2749	elem.classe=long_n;
2750	push(&elem);
2751	IFERR_GOTO;
2752	ni=(l_code *) next_infoi(ni);
2753	break;
2754	}
2755
2756	case load_maxmfn:
2757	{ /* tamanho de caracteres sao ignorados */
2758	elem.op.l= (float_x ) 0;
2759	if (RECdbxp) elem.op.l= (float_x ) RDBmsmfn; /* il fault faire.. */
2760	elem.classe=long_n;
2761	push(&elem);
2762	IFERR_GOTO;
2763	ni=(l_code *) next_infoi(ni);
2764	break;
2765	}
2766	case load_core:
2767	{ /* tamanho de caracteres sao ignorados */
2768	#if CICPP
2769	elem.op.l= (float_x ) 0;
2770	#else /* CICPP */
2771	elem.op.l= (float_x ) CORELEFT();
2772	#endif /* CICPP */
2773	elem.classe=long_n;
2774	push(&elem);
2775	IFERR_GOTO;
2776	ni=(l_code *) next_infoi(ni);
2777	break;
2778	}
2779
2780	case noccins:
2781	{
2782	elem.op.l=fmt_load_all_occ();
2783	IFERR_GOTO;
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 ioccins:
2795	{
2796	elem.op.l=(LONGX )next_rep_occ;
2797	elem.classe=long_n;
2798	push(&elem);
2799	IFERR_GOTO;
2800	#if DEB_NOCC
2801	printf("\n Numero de ocorrencias=%d\n",elem.op.l);
2802	#endif
2803	ni=(l_code *) next_infoi(ni);
2804	break;
2805	}
2806
2807	case present :
2808	case absent :
2809	{
2810	#if ONE_MORE_OCCS
2811	if (itf->max_occ>itf->actual_occ) must_repeat=true; /* SVD 21/11/91 */
2812	#endif
2813	if (rep_group==true)
2814	{
2815	/* copia para temporaria */
2816	itf=(field_definition_node *)iadd(ni);
2817	if( itf->max_occ == -1)
2818	{
2819	fmt_load_all_occ(); /* para inicializar intervalos 27-12-94 */
2820	IFERR_GOTO;
2821	itf->actual_occ=0;
2822	}
2823	*fd_value=null_char;
2824	itf->actual_occ=next_rep_occ;
2825	#if !ONE_MORE_OCCS
2826	if (itf->max_occ>itf->actual_occ) must_repeat=true; /* SVD 21/11/91 */
2827	#endif
2828	if (itf->max_occ >= itf->actual_occ) {fmt_load_next_occ();IFERR_GOTO;}
2829	}
2830	else {
2831	fmt_load_all_occ();
2832	IFERR_GOTO;
2833	#if TRACE_INTER_2
2834	printf("\n Apos fmt_load_all_occ/2 fd_value=%s",fd_value);
2835	#endif
2836	}
2837	elem.classe=logical;
2838	if (infoi(ni)==absent) elem.op.boolean= *fd_value==null_char?true:false;
2839	if (infoi(ni)==present) elem.op.boolean= *fd_value==null_char?false:true;
2840	push(&elem);
2841	IFERR_GOTO;
2842	ni=(l_code *) next_infoi(ni);
2843	break;
2844	}
2845
2846	case duptop: /duplica a expressao do select para testar com cases /
2847	{
2848	auxpop = pop(); IFERR_GOTO;
2849	push(auxpop); IFERR_GOTO;
2850	push(auxpop); IFERR_GOTO;
2851	ni=(l_code *) next_infoi(ni);
2852	break;
2853	}
2854	case end_select: /* retira a expressao do select do topo */
2855	{
2856	auxpop =pop(); IFERR_GOTO;
2857	ni=(l_code *) next_infoi(ni);
2858
2859	break;
2860	}
2861	case jumpf:
2862	{
2863	auxpop = pop(); IFERR_GOTO;
2864	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2865	is_not_of_class(top->classe,logical);
2866	IFERR_GOTO;
2867	if(top->op.boolean==false) ni=(l_code *) iadd(ni);
2868	else ni=(l_code *) next_infoi(ni);
2869	break;
2870
2871	}
2872
2873	case jumpt:
2874	{
2875	auxpop = pop(); IFERR_GOTO;
2876	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
2877	is_not_of_class(top->classe,logical);
2878	IFERR_GOTO;
2879
2880	if(top->op.boolean==true) ni=(l_code *) iadd(ni);
2881	else ni=(l_code *) next_infoi(ni);
2882
2883	break;
2884	}
2885
2886	case jump:
2887	case breakins: /* pulo incondicional */
2888	{
2889	ni=(l_code *) iadd(ni);
2890	break;
2891	}
2892	case or_op :
2893	case and_op:
2894	{
2895	retrieve_two_logical_operands;
2896	IFERR_GOTO;
2897	if(infoi(ni)==and_op)elem.op.boolean=op1->op.boolean && op2->op.boolean;
2898	if(infoi(ni)==or_op )elem.op.boolean=op1->op.boolean \|\| op2->op.boolean;
2899	push(&elem);
2900	IFERR_GOTO;
2901	ni=(l_code *) next_infoi(ni);
2902	break;
2903	}
2904	case not_op:
2905	{
2906	auxpop = pop(); IFERR_GOTO;
2907	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
2908	is_not_of_class(op1->classe,logical);
2909	IFERR_GOTO;
2910	elem.classe=logical;
2911	elem.op.boolean=!op1->op.boolean ;
2912	push(&elem);
2913	IFERR_GOTO;
2914	ni=(l_code *) next_infoi(ni);
2915	break;
2916	}
2917	case neq_op :
2918	case gtr_op :
2919	case lss_op :
2920	case leq_op :
2921	case geq_op :
2922	case eql_op :
2923	{
2924	instruction=infoi(ni);
2925	retrieve_two_operands ();
2926	IFERR_GOTO;
2927	switch (class_of_the_both)
2928	{
2929
2930	case string :
2931	{
2932	result=strcmp(op1->op.s,op2->op.s);
2933	switch (instruction) {
2934	case neq_op: cond_code= (result != 0)?true:false; break;
2935	case gtr_op: cond_code= (result > 0)?true:false; break;
2936	case lss_op: cond_code= (result < 0)?true:false; break;
2937	case leq_op: cond_code= (result <= 0)?true:false; break;
2938	case geq_op: cond_code= (result >= 0)?true:false; break;
2939	case eql_op: cond_code= (result == 0)?true:false; break;
2940	}
2941	break;
2942	}/* string */
2943	case long_n :
2944	{
2945	switch (instruction) {
2946	case neq_op: cond_code= (long_value_1 != long_value_2 )?true:false; break;
2947	case gtr_op: cond_code= (long_value_1 > long_value_2 )?true:false; break;
2948	case lss_op: cond_code= (long_value_1 < long_value_2 )?true:false; break;
2949	case leq_op: cond_code= (long_value_1 <= long_value_2 )?true:false; break;
2950	case geq_op: cond_code= (long_value_1 >= long_value_2 )?true:false; break;
2951	case eql_op: cond_code= (long_value_1 == long_value_2 )?true:false; break;
2952	}
2953	break;
2954	}/integer /
2955	case float_n :
2956	{
2957	#if DEB_FLOAT
2958	printf("\n Vai comparar (%f) com (%f)",float_value_1,float_value_2);
2959	#endif
2960	switch (instruction) {
2961	case neq_op: cond_code=(float_value_1 != float_value_2)?true:false; break;
2962	case gtr_op: cond_code=(float_value_1 > float_value_2)?true:false; break;
2963	case lss_op: cond_code=(float_value_1 < float_value_2)?true:false; break;
2964	case leq_op: cond_code=(float_value_1 <= float_value_2)?true:false; break;
2965	case geq_op: cond_code=(float_value_1 >= float_value_2)?true:false; break;
2966	case eql_op: cond_code=(float_value_1 == float_value_2)?true:false; break;
2967	}
2968	break;
2969	}/integer /
2970
2971	case integer :
2972
2973	{
2974	switch (instruction) {
2975	case neq_op: cond_code= (int_value_1 != int_value_2 )?true:false; break;
2976	case gtr_op: cond_code= (int_value_1 > int_value_2 )?true:false; break;
2977	case lss_op: cond_code= (int_value_1 < int_value_2 )?true:false; break;
2978	case leq_op: cond_code= (int_value_1 <= int_value_2 )?true:false; break;
2979	case geq_op: cond_code= (int_value_1 >= int_value_2 )?true:false; break;
2980	case eql_op: cond_code= (int_value_1 == int_value_2 )?true:false; break;
2981	}
2982	break;
2983	}/integer /
2984
2985	default:
2986	{
2987	inter_error("Operations for these classes of operands not implemented");
2988	IFERR_GOTO;
2989	}
2990	} /* switch */
2991	elem.classe=logical;
2992	elem.op.boolean=cond_code;
2993	push(&elem);
2994	IFERR_GOTO;
2995	ni=(l_code *) next_infoi(ni);
2996	break;
2997
2998	}
2999	case plus_op :
3000	case minus_op :
3001	case divide_op :
3002	case times_op :
3003	{
3004	instruction=infoi(ni);
3005	retrieve_two_numeric_operands();
3006	IFERR_GOTO;
3007
3008
3009	switch(new_class)
3010	{
3011	case integer:
3012	{
3013	if (instruction==plus_op) tempint=int_value_1 + int_value_2;
3014	if (instruction==minus_op) tempint=int_value_1 - int_value_2;
3015	if (instruction==times_op) tempint=int_value_1 * int_value_2;
3016	if (instruction==divide_op)tempint=int_value_1 / int_value_2;
3017	elem.classe=new_class;
3018	elem.op.i=tempint;
3019	break;
3020	}
3021	case long_n:
3022	{
3023	if (instruction==plus_op) templong=long_value_1 + long_value_2;
3024	if (instruction==minus_op) templong=long_value_1 - long_value_2;
3025	if (instruction==times_op) templong=long_value_1 * long_value_2;
3026	if (instruction==divide_op)templong=long_value_1 / long_value_2;
3027	elem.classe=long_n;
3028	elem.op.l=templong;
3029	break;
3030	}
3031
3032	case float_n:
3033	{
3034	if (instruction==plus_op) tempfloat=float_value_1 + float_value_2;
3035	if (instruction==minus_op) tempfloat=float_value_1 - float_value_2;
3036	if (instruction==times_op) tempfloat=float_value_1 * float_value_2;
3037	if (instruction==divide_op)tempfloat=float_value_1 / float_value_2;
3038
3039	elem.classe=float_n;
3040	elem.op.r=tempfloat;
3041	break;
3042	}
3043
3044	default:
3045	{
3046	inter_error("Operations for these classes of operands not implemented");
3047	IFERR_GOTO;
3048	break;
3049	}
3050	} /* switch */
3051	push(&elem);
3052	IFERR_GOTO;
3053	ni=(l_code *) next_infoi(ni);
3054	break;
3055	}
3056
3057	case x_spac:
3058	{
3059	qty=iadd(ni);
3060	if( (lw_inter-nextcc)>qty ) /* is room */
3061	{
3062	/* repeat_space(out,pout,qty) */
3063	memset(out+pout,' ',qty); pout+=qty;
3064	nextcc=nextcc+qty;
3065	out[pout]=null_char;
3066	}
3067	else
3068	{ /* there's no room */
3069	/A07 new_line(out,pout); /
3070	new_line(out,pout,outsize);
3071	nextcc=1;
3072	}
3073
3074
3075
3076	ni=(l_code *) next_infoi(ni);
3077	break;
3078	}
3079
3080	case c_spac:
3081	{
3082	qty=iadd(ni);
3083	if(qty<=lw_inter)
3084	{
3085
3086	if( nextcc > qty )
3087	{
3088	/A07 new_line(out,pout); /
3089	new_line(out,pout,outsize);
3090	nextcc=1;
3091	}
3092	while (nextcc<qty )
3093	{ out[pout++]=' ';
3094	out[pout]=null_char;
3095	nextcc++;
3096	} /while/
3097	} /* number spaces > lw_inter - ignores the command */
3098	ni=(l_code *) next_infoi(ni);
3099	break;
3100	}
3101
3102	case percent_spac:
3103	{
3104	#if MICRO_ISIS_COMPATIBLE
3105	int nn;
3106	nn=exec_percent(out,&pout,&nextcc);
3107	#endif
3108	ni=(l_code *) next_infoi(ni);
3109	#if MICRO_ISIS_COMPATIBLE
3110	/* se ja existe mudanca de linha e prox instrucao #, ignora-a */
3111	if ( (nn>0) && (infoi(ni)==n_sign_spac) )
3112	ni=(l_code *) next_infoi(ni);
3113	#endif
3114	break;
3115	}
3116
3117	case n_sigx_spac:
3118	/* see case x_spac: */
3119	{
3120	qty=iadd(ni);
3121	while (qty > 0) {
3122	char p,q;
3123	int mlen,hlen,qlen;
3124	mlen=RECnbytes-(MFRmfrl+sizeof(DIRSTRU));
3125	if (mlen <= (hlen=1+6+1+9+1)+2) break;
3126	p=MFX+(MFRmfrl+sizeof(DIRSTRU));
3127	sprintf(p,"H%6"_LD_" %9"_LD_" ",(LONGX)qty,0L);
3128	q=p+hlen; if (!fgets(q, mlen-hlen, stdin)) break;
3129	qlen=strlen(q); if (!qlen) break;
3130	if (q[--qlen] != '\n') break;
3131	sprintf(p+hlen-(9+1),"%9"_LD_,(LONGX)qlen); p[hlen-1]=' ';
3132	#if CICPP
3133	p=recp->xfldupdat(p);
3134	#else /* CICPP */
3135	p=fldupdat(irec,p);
3136	#endif /* CICPP */
3137	if (p) fatal(p);
3138	qty=0;
3139	}
3140	ni=(l_code *) next_infoi(ni);
3141	break;
3142	}
3143
3144	case n_sign_spac:
3145	{
3146	/A07 new_line(out,pout); /
3147	new_line(out,pout,outsize);
3148	nextcc=1; /* upadtes next position avaialble in line */
3149	ni=(l_code *) next_infoi(ni);
3150	break;
3151	}
3152	case slash_spac:
3153	{
3154	if(! (fmt_CRLF(out,pout) \|\| pout==0) )
3155	{
3156	/A07 new_line(out,pout); /
3157	new_line(out,pout,outsize);
3158	nextcc=1; /* updates next position available in the output */
3159	}
3160	ni=(l_code *) next_infoi(ni);
3161	break;
3162
3163	}
3164
3165	case test_rep:
3166	{
3167	/* Implementacao do continue 17-7-94 */
3168	if (continue_rgroup==true){
3169	if (next_rep_occ <= /* ou < ?*/ continue_rgroup_maxocc)
3170	must_repeat=true;
3171	}
3172
3173	/* Tentativa de Implementar v70[1] dentro de repetitivo */
3174	/* 30-12-94 */
3175	if (rep_group==true && !NO_INTERVAL(itf)) {
3176	if (next_rep_occ < /* ou <= ?*/ continue_rgroup_maxocc)
3177	must_repeat=true;
3178	}
3179	elem.classe=logical;
3180	elem.op.boolean=must_repeat;
3181	push(&elem);
3182	IFERR_GOTO;
3183	ni=(l_code *) next_infoi(ni);
3184	break;
3185	}
3186
3187	case set_true_rep:
3188	{
3189	must_repeat=true;
3190	ni=(l_code *) next_infoi(ni);
3191	break;
3192	}
3193	case set_false_rep:
3194	{
3195	must_repeat=false;
3196	/* Implementar continue 17-7-94 */
3197	continue_rgroup=false;
3198	ni=(l_code *) next_infoi(ni);
3199	break;
3200	}
3201	case mpl_par:
3202	case mpu_par:
3203	case mdl_par:
3204	case mdu_par:
3205	case mhl_par:
3206	case mhu_par:
3207	{
3208	actual_mode=infoi(ni);
3209	ni=(l_code *) next_infoi(ni);
3210	break;
3211	}
3212
3213	case contains:
3214	{
3215	auxpop = pop(); IFERR_GOTO;
3216	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
3217	auxpop = pop(); IFERR_GOTO;
3218	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
3219	elem.classe=logical;
3220	if (op1->classe!=op2->classe \|\| op1->classe!=string)
3221	{inter_error("Invalid operands for ':' operator ");
3222	IFERR_GOTO;
3223	}
3224	else
3225	{if(strstr(op1->op.s,op2->op.s)!=null_char)elem.op.boolean=true;
3226	else elem.op.boolean=false;
3227
3228	}
3229	push(&elem);
3230	IFERR_GOTO;
3231	ni=(l_code *) next_infoi(ni);
3232	break;
3233
3234	}
3235
3236	case instr_end:
3237	{
3238	auxpop = pop(); IFERR_GOTO;
3239	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
3240	auxpop = pop(); IFERR_GOTO;
3241	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
3242	if (op1->classe!=op2->classe \|\| op1->classe!=string)
3243	{inter_error("Invalid operands for 'instr' operator ");
3244	IFERR_GOTO;
3245	}
3246	else{
3247	restore_context();
3248	elem.classe=long_n;
3249	elem.op.l= (LONGX) fmt_instr(op1->op.s,op2->op.s);
3250	}
3251	push(&elem);
3252	IFERR_GOTO;
3253	ni=(l_code *) next_infoi(ni);
3254	break;
3255
3256	}
3257
3258	case right_end:
3259	case left_end:
3260	{
3261	int lng,xn;
3262	char *tt;
3263	auxpop = pop(); IFERR_GOTO;
3264	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
3265	auxpop = pop(); IFERR_GOTO;
3266	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
3267	if (op1->classe!=string \|\| !is_numeric(op2->classe)){
3268	inter_error("Invalid operands for ':' operator ");
3269	IFERR_GOTO;
3270	}else{
3271	tt=(char *)op1->op.s;
3272	//lng=strlen(tt);
3273	lng=strlen_UTF8(tt);
3274	xn=cast_to_int(op2);
3275	if (xn<0) xn=0;
3276	if (infoi(ni)==right_end){
3277	#if TRACE_STRFUN
3278	printf( "\n lng=%d caracters a direita de =%s=",xn,op1->op.s);
3279	#endif
3280	lng=lng-xn;
3281	if (lng<0) lng=0;
3282	//tt= (char *) (tt + lng);
3283	tt= (char *) skipchar_UTF8(tt,lng);
3284	#if TRACE_STRFUN
3285	printf ("%s\n",tt);
3286	#endif
3287	}
3288	if (infoi(ni)==left_end){
3289	#if TRACE_STRFUN
3290	printf( "\n lng=%d caracters a esquerda de =%s=",xn,op1->op.s);
3291	#endif
3292	if ( lng> xn) lng=xn;
3293	if (lng <0) lng=0;
3294	//tt[lng]=null_char;
3295	skipchar_UTF8(tt,lng)[0]=null_char;
3296	#if TRACE_STRFUN
3297	printf ("%s\n",tt);
3298	#endif
3299	}
3300	}
3301	restore_context();
3302	elem.op.s=tt;
3303	elem.classe=string;
3304	push(&elem);
3305	IFERR_GOTO;
3306	ni=(l_code *) next_infoi(ni);
3307	break;
3308	}
3309
3310	case mid_end: /* mid(string,start,lenght) */
3311	case ss_end: /A10 ss(pos,length,string) */
3312	{
3313	/* op1 - string
3314	op2 - start
3315	op3 -length
3316	*/
3317	int lng,xn_inic,xn_fim;
3318	stack_node op3_node;
3319	stack_node *op3;
3320	char *tt;
3321	if (infoi(ni)==mid_end){
3322	auxpop = pop(); IFERR_GOTO;
3323	op3=(stack_node *)memcpy(&op3_node,auxpop,sizeof(stack_node));
3324	auxpop = pop(); IFERR_GOTO;
3325	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
3326	auxpop = pop(); IFERR_GOTO;
3327	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
3328	}
3329	if (infoi(ni)==ss_end) {
3330	auxpop = pop(); IFERR_GOTO;
3331	op1=(stack_node *)memcpy(&op3_node,auxpop,sizeof(stack_node));
3332	auxpop = pop(); IFERR_GOTO;
3333	op3=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
3334	auxpop = pop(); IFERR_GOTO;
3335	op2=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
3336	}
3337	if (op1->classe!=string \|\| !is_numeric(op2->classe) \|\|
3338	!is_numeric(op3->classe )){
3339	inter_error("Invalid operands for ':' operator ");
3340	IFERR_GOTO;
3341	}else{
3342	tt=(char *)op1->op.s;
3343	//lng=strlen(tt);
3344	lng=strlen_UTF8(tt);
3345	xn_inic=cast_to_int(op2);
3346	xn_fim=cast_to_int(op3);
3347	#if TRACE_STRFUN
3348	printf( "\n inic=%d fim=%d a direita de =%s=",xn_inic,xn_fim,tt);
3349	#endif
3350	if (xn_inic<=0) xn_inic=1;
3351	if (xn_inic>lng) xn_inic=lng+1;
3352	//tt=(char *) (tt + xn_inic-1);
3353	tt=(char *) skipchar_UTF8(tt,xn_inic-1);
3354	//lng=strlen(tt);
3355	lng=strlen_UTF8(tt);
3356	if (xn_fim<0) xn_fim=0;
3357	if (xn_fim>lng) xn_fim=lng;
3358	//tt[xn_fim]=null_char;
3359	skipchar_UTF8(tt,xn_fim)[0]=null_char;
3360	#if TRACE_STRFUN
3361	printf ("%s\n",tt);
3362	#endif
3363	restore_context();
3364	elem.op.s=tt;
3365	elem.classe=string;
3366	push(&elem);
3367	IFERR_GOTO;
3368	ni=(l_code *) next_infoi(ni);
3369	break;
3370	}
3371	}
3372
3373	#if CI_XMLELEM
3374	#include "exmlelem.c"
3375	#endif
3376
3377	case replac_end:
3378	{
3379	int lng,nx,lngfrom,lngto,difflen;
3380	stack_node op3_node;
3381	stack_node *op3;
3382	char strtorep,strfrom,strto,p1,p2,pnew;
3383	/* sintaxe: REPLACE(strtorep,strfrom,strto) */
3384	nx=0;
3385	auxpop = pop(); IFERR_GOTO;
3386	op3=(stack_node *)memcpy(&op3_node,auxpop,sizeof(stack_node));
3387	auxpop = pop(); IFERR_GOTO;
3388	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
3389	auxpop = pop(); IFERR_GOTO;
3390	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
3391	if (op1->classe!=string \|\| op2->classe!=string \|\|
3392	op3->classe!=string ){
3393	inter_error("Invalid operands for 'replace' function ");
3394	IFERR_GOTO;
3395	}else{
3396	strtorep=(char *)op1->op.s;
3397	strfrom=(char *)op2->op.s;
3398	strto=(char *)op3->op.s;
3399	lng=strlen(strtorep);
3400	lngfrom=strlen(strfrom);
3401	lngto=strlen(strto);
3402	difflen=0;
3403	if (lngto>lngfrom) difflen=lngto-lngfrom;
3404	#if TRACE_REPLACE
3405	printf( "\nRepl_str= \|%d\| \|%s\|",lng,strtorep);
3406	printf("\n Repl_from=\|%d\| \|%s\|",lngfrom,strfrom);
3407	printf("\n Repl_to= \|%d\| \|%s\|",lngto,strto);
3408	#endif
3409	nx=0;
3410	p1=strtorep;
3411	if (lngfrom <=0) p1=NULL; /* Nao tem o que substituir. O
3412	Algoritmo entraria em loop */
3413	/* Deternina a quantidade de substituicoes a serem feitas para
3414	calcular o tamanho do novo string a ser alocado */
3415	while (p1!=NULL){
3416	#if TRACE_REPLACE
3417	printf("\n Testando oc nx:\|%d\| em:\|%s\|",nx,p1);
3418	#endif
3419	p2=strstr(p1,strfrom);
3420	if (p2 !=NULL) {
3421	p2=p2+lngfrom;
3422	nx++;
3423	}
3424	p1=p2;
3425	}
3426	if (nx ==0 ) {
3427	pnew=strtorep; /* Nao tem nada a substituir */
3428	}else {
3429	pnew=fmt_alloc_char( (ALLOPARM)(lng+1+nx*difflen),
3430	"cifm3/replace/alloc");
3431	if (pnew == NULL) IFERR_GOTO;
3432	*pnew=null_char;
3433	p1=strtorep;
3434	while (p1!=NULL) {
3435	#if TRACE_REPLACE
3436	printf("\n Substiutindo orig:\|%s\|",p1);
3437	printf("\n Substituindo new :\|%s\|",pnew);
3438	#endif
3439	p2=strstr(p1,strfrom);
3440	if (p2!=NULL) {
3441	*p2=null_char;
3442	strcat(pnew,p1);
3443	strcat(pnew,strto);
3444	p2=p2+lngfrom;
3445	}else strcat(pnew,p1); /* concatena ultimo pedaco */
3446	p1=p2;
3447	}/while /
3448	} /* else */
3449	restore_context();
3450	elem.op.s=store_tmp_string(pnew);
3451	elem.classe=string;
3452	push(&elem);
3453	IFERR_GOTO;
3454	if (nx > 0) { /* houve alocacao de memoria */
3455	#if CICPP
3456	delete [] (char *)pnew;;
3457	#else
3458	FREE(pnew);
3459	#endif
3460	}
3461	ni=(l_code *) next_infoi(ni);
3462	break;
3463	}
3464	}
3465
3466
3467
3468	case begin_rep_gr:
3469	{
3470	if(rep_group==false)
3471	{rep_group=true;
3472	next_rep_occ=1;
3473	}
3474	else next_rep_occ++;
3475	#if FMT_OPTIMIZE
3476	must_repeat=false;
3477	/* Implementar continue 17-7-94 */
3478	continue_rgroup=false;
3479	#endif
3480	ni=(l_code *) next_infoi(ni);
3481	break;
3482	}
3483	case ref_beg:
3484	{
3485	#if CICPP /ifcmm/
3486	elem.classe=type_recstru;
3487	elem.op.lrecp=recp;
3488	#else /elsecmm/
3489	elem.classe=long_n;
3490	elem.op.l=irec;
3491	#endif /CICPP/ /endcmm/
3492	push(&elem);
3493	IFERR_GOTO;
3494	#if 0 /* AOT+RP - 15/01/97 - read_mfn ja' chama fmt_comum_ref_beg() */
3495	fmt_comum_ref_beg();
3496	#endif
3497	ni=(l_code *) next_infoi(ni);
3498	break;
3499	}
3500
3501	case ref_end:
3502	{
3503	fmt_comum_ref_end();
3504	IFERR_GOTO;
3505	ni=(l_code *) next_infoi(ni);
3506	break;
3507	}
3508	case refu_beg:
3509	{
3510	save_context(no_modify_fmt_pointers);
3511	IFERR_GOTO;
3512	#if CICPP /ifcmm/
3513	elem.classe=type_recstru;
3514	elem.op.lrecp=recp;
3515	#else /elsecmm/
3516	elem.classe=long_n;
3517	elem.op.l=irec;
3518	#endif /CICPP/ /endcmm/
3519	push(&elem);
3520	IFERR_GOTO;
3521	#if 0 /* AOT+RP - 15/01/97 - read_mfn ja' chama fmt_comum_ref_beg() */
3522	fmt_comum_ref_beg();
3523	#endif
3524	ni=(l_code *) next_infoi(ni);
3525	break;
3526	}
3527
3528	case refu_end:
3529	{
3530	fmt_comum_ref_end();
3531	IFERR_GOTO;
3532	restore_context();
3533	IFERR_GOTO;
3534	tmp_ptr=store_tmp_string(tmp_ptr);
3535	IFERR_GOTO;
3536	out[pout]=null_char;
3537	elem.op.s=tmp_ptr;
3538	elem.classe=string;
3539	push(&elem);
3540	IFERR_GOTO;
3541	ni=(l_code *) next_infoi(ni);
3542	break;
3543	}
3544
3545	case read_mfn:
3546	{
3547	auxpop = pop(); IFERR_GOTO;
3548	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3549	ref_mfn_number=fmt_cnv_to_long(top);
3550	/* se mfn=0; nao ha registro para formatar
3551	precisa ignorar todas as instrucoes relativas ao formato do ref
3552	deixando como instrucao a ultima ref_end
3553	Quando existe base de dados, o nome dela esta na pilha
3554	campo iadd(i), vale 1L. Caso contrario vale 0L
3555	*/
3556	literal[0]=null_char;
3557	if ((LONGX )iadd(ni) ==1L){
3558	auxpop = pop(); IFERR_GOTO;
3559	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3560	strcpy(literal, (char *) top->op.s );
3561	/A06 Nao realoquei porque o nome do dbn tem que ser menor que 255/
3562	}else strcpy(literal, firstdbnp);
3563	#if BEFORE20030514
3564	if (ref_mfn_number==0L){
3565	#else
3566	if (ref_mfn_number<=0L){
3567	#endif
3568	fmt_fim=false;
3569	fmt_n_ref=1;
3570	while (fmt_fim==false){
3571	if(infoi(ni)==ref_beg \|\| infoi(ni)==refu_beg) fmt_n_ref++;
3572	if(infoi(ni)==ref_end \|\| infoi(ni)==refu_end) fmt_n_ref--;
3573	if(fmt_n_ref==0) fmt_fim=true; else ni=(l_code *) next_infoi(ni);
3574	}
3575	}else{
3576	#define KEEPDBXR 0
3577	#if KEEPDBXR
3578	LONGX idbx,keepndbx=ndbxs;
3579	#endif /* KEEPDBXR */
3580
3581	fmt_comum_ref_beg();
3582
3583	#if CICPP /ifcmm/
3584	recp->xrecord(literal,ref_mfn_number);
3585	#else /elsecmm/
3586	RECORD(irec,literal,ref_mfn_number);
3587	#endif /CICPP/ /endcmm/
3588
3589	#define FMTMFLUSH 0
3590	#if FMTMFLUSH
3591	if (strcmp(firstdbnp,literal)) mstflush(literal);
3592	#endif
3593
3594	#if KEEPDBXR
3595	for (idbx=ndbxs-1; idbx>=keepndbx; idbx--)
3596	dbxflush(vdbxp[idbx]->dbxname);
3597	#endif /* KEEPDBXR */
3598
3599	/* Alocacao das maiores areas originalmente estaticas - AOT 29/12/90 */
3600	#if DINALLOC
3601	if (!fmt_fsiz) {
3602	for (xdir=MFRnvf, xfsiz=0; xdir--; )
3603	if (DIRlen(xdir) > xfsiz) xfsiz=DIRlen(xdir);
3604	if (xfsiz > din_fsiz) {
3605	din_fsiz=xfsiz;
3606	if (fmttrace) printf("+++ fmt_inter - din_fsiz=%"_LD_"\n",din_fsiz);
3607	max_fd_value=din_fsiz;
3608	max_fd_tmp=din_fsiz;
3609	#if CICPP
3610	delete [] (char *)v_fd_value;
3611	delete [] (char *)v_fd_tmp;
3612	#else /* CICPP */
3613	FREE(v_fd_value);
3614	FREE(v_fd_tmp);
3615	#endif /* CICPP */
3616	#if CICPP
3617	try
3618	{ v_fd_value= (char *)new char [(max_fd_value+1)]; }
3619	catch (BAD_ALLOC)
3620	{ v_fd_value= (char *)NULL; }
3621	#else /* CICPP */
3622	v_fd_value= (char *)ALLOC((ALLOPARM)(max_fd_value+1));
3623	#endif /* CICPP */
3624	if (v_fd_value== (char *)NULL)
3625	{
3626	inter_error("1003");
3627	IFERR_GOTO;
3628	}
3629	#if CICPP
3630	try
3631	{ v_fd_tmp= (char *) new char[(max_fd_tmp+1)]; }
3632	catch (BAD_ALLOC)
3633	{ v_fd_tmp= (char *)NULL; }
3634	#else /* CICPP */
3635	v_fd_tmp= (char *)ALLOC((ALLOPARM)(max_fd_tmp+1));
3636	#endif /* CICPP */
3637	if (v_fd_tmp== (char *)NULL)
3638	{
3639	inter_error("1004");
3640	IFERR_GOTO;
3641	}
3642	fd_value=v_fd_value; /* DINALLOC */
3643	}
3644	}
3645	#endif
3646	ni=(l_code *) next_infoi(ni);
3647	}
3648	break;
3649	}
3650
3651	case rupd_beg:
3652	case rupx_beg:
3653	case syst_beg:
3654	case date_mktime_beg:
3655	case l_beg:
3656	case np_beg:
3657	{
3658	save_context(modify_fmt_pointers);
3659	IFERR_GOTO;
3660	/* o formato a ser processado devera ser usado na lookup */
3661	ni=(l_code *)next_infoi(ni);
3662	break;
3663	}
3664
3665	case rupd_end:
3666	case rupx_end:
3667	case syst_end:
3668	case date_mktime_end:
3669	case l_end:
3670	case np_end:
3671	{
3672	LONGX p_mfn_lookup;
3673	LONGX nord;
3674
3675	/* Se houve referencia a database ele esta na pilha */
3676	new_dbname=NULL;
3677	if ((LONGX )iadd(ni) ==1L){
3678	auxpop = pop(); IFERR_GOTO;
3679	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3680	new_dbname=top->op.s; /* antes copiava para outra area*/
3681	}
3682
3683	/copia para tmp_str e restaura contexto /
3684	restore_context();
3685	IFERR_GOTO;
3686	tmp_ptr=store_tmp_string(tmp_ptr);
3687	IFERR_GOTO;
3688	out[pout]=null_char;
3689
3690	if (infoi(ni) == rupd_end) {
3691	char *p;
3692	#if CICPP
3693	p=recp->xfldupdat(tmp_ptr);
3694	#else /* CICPP */
3695	p=fldupdat(irec,tmp_ptr);
3696	#endif /* CICPP */
3697	if (p) fatal(p);
3698	ni=(l_code *)next_infoi(ni);
3699	break;
3700	}
3701	if (infoi(ni) == rupx_end) {
3702	/* procx.c */
3703	#if FUNPROCX
3704	#if MXFUN \|\| IFLOADFUN
3705	char *p=tmp_ptr;
3706	while (isspace(*p)) p++;
3707	#if MXFUN
3708	if (strncmp(p,"mx",2) == 0 && isspace(*(p+2))) { cisis_mx(p+2+1); }
3709	#endif /* MXFUN */
3710	#if IFLOADFUN
3711	if (strncmp(p,"ifload",6) == 0 && isspace(*(p+6))) { cisis_ifload(p+6+1); }
3712	#endif /* IFLOADFUN */
3713	#endif /* MXFUN \|\| IFLOADFUN */
3714	#endif /* FUNPROCX */
3715	ni=(l_code *)next_infoi(ni);
3716	break;
3717	}
3718
3719	if (infoi(ni) == syst_end) {
3720	/* system(tmp_ptr); AOT - 19/03/97 */
3721	char shp,p;
3722	for (shp=tmp_ptr; *shp; ) {
3723	for (p=shp; *p; p++)
3724	if (p == '\n' \|\| p == '\r') {
3725	*p++ = '\0';
3726	if (p == '\n' \|\| p == '\r') *p++ = '\0';
3727	break;
3728	}
3729	if (*shp) system(shp);
3730	shp = p;
3731	}
3732	ni=(l_code *)next_infoi(ni);
3733	break;
3734	}
3735
3736	if (infoi(ni) == date_mktime_end) {
3737	/* mktime(<fmt>) AOT - 16/02/2001 */
3738	int year,mon,day,hour,min,sec;
3739	struct tm tpx;
3740	struct tm *tp= &tpx;
3741	char *p;
3742	/*The allowable range of calendar times is Jan 1 1970 00:00:00 to Jan 19 2038 03:14:07.
3743	*/
3744	if (strcmp(tmp_ptr,(p="19700102 000000")) < 0) strcpy(tmp_str,p);
3745	if (strcmp(tmp_ptr,(p="20380118 031407")) > 0) strcpy(tmp_str,p);
3746	sscanf(tmp_ptr,"%4d%2d%2d",&year,&mon,&day);
3747	hour=min=sec=0;
3748	if (strlen(tmp_ptr)>=11) sscanf(tmp_ptr+8, "%*c%2d",&hour);
3749	if (strlen(tmp_ptr)>=13) sscanf(tmp_ptr+11,"%2d",&min);
3750	if (strlen(tmp_ptr)>=15) sscanf(tmp_ptr+13,"%2d",&sec);
3751	tpx.tm_year=year-1900;
3752	tpx.tm_mon=mon-1;
3753	tpx.tm_mday=day;
3754	tpx.tm_hour=hour;
3755	tpx.tm_min=min;
3756	tpx.tm_sec=sec;
3757	tpx.tm_wday=tpx.tm_yday=0;
3758	#if 0
3759	time_t mktime(struct tm *t);
3760	Converts the time in the structure pointed to by t
3761	into a calendar time with the same format used by the time function.
3762	#endif
3763	elem.op.l=mktime(tp);
3764	elem.classe=long_n;
3765	push(&elem);
3766	IFERR_GOTO;
3767	ni=(l_code *)next_infoi(ni);
3768	break;
3769	}
3770
3771
3772	#if CICPP
3773	TRMSTRU *trmp;
3774	try { trmp=new TRMSTRU(cisisxp); }
3775	catch (BAD_ALLOC) { fatal("fmt/inter/reftrm/next"); }
3776	#else /* CICPP */
3777	for (trm_prat=maxntrm; trm_prat--; ){
3778	if (!vtrmp[trm_prat]) /* ja' decrementado */
3779	break;
3780	}
3781	if (!trm_prat) fatal("fmt/inter/reftrm/next");
3782	#endif /* CICPP */
3783	/A03/
3784	/A04/
3785	/* Modifica o tipo de acesso de posting para pedir total de
3786	posting para instrucao NP ou o primeiro MFN em caso de
3787	da instrucao LOOKUP
3788	*/
3789	nord=0L; /* supoe NP */
3790	if ( infoi(ni)==l_end)nord=1L;
3791
3792	if (new_dbname==NULL) new_dbname=firstdbnp; /* nao muda o acesso */
3793
3794	upcase_mode(tmp_ptr);
3795	#if CICPP
3796	p_mfn_lookup=lookup(tmp_ptr,trmp,new_dbname,nord);
3797	#else /* CICPP */
3798	p_mfn_lookup=lookup(tmp_ptr,trm_prat,new_dbname,nord);
3799	#endif /* CICPP */
3800
3801	/A03/
3802	#if CICPP
3803	delete trmp;
3804	#else /* CICPP */
3805	if (vtrmp[trm_prat]!=NULL) { /* SVD 14-05-92 */
3806	FREE(vtrmp[trm_prat]); vtrmp[trm_prat]=NULL; ntrms--;
3807	} /* SVD 14-05-92 */
3808	#endif /* CICPP */
3809
3810	if (p_mfn_lookup <0) p_mfn_lookup=0;
3811
3812	elem.op.l=p_mfn_lookup;
3813	elem.classe=long_n;
3814	push(&elem);
3815	IFERR_GOTO;
3816
3817	ni=(l_code *)next_infoi(ni);
3818	break;
3819	}
3820
3821	case lw_beg:
3822	{
3823	ni=(l_code *) next_infoi(ni);
3824	break;
3825	}
3826
3827	case lw_end:
3828	{ /* valor do numero gerado da pilha */
3829	fd_value[0]=null_char;
3830	auxpop = pop(); IFERR_GOTO;
3831	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3832	is_numeric(top->classe);
3833	IFERR_GOTO;
3834	lw_inter=(LONGX)top->op.l;
3835	ni=(l_code *) next_infoi(ni);
3836	break;
3837	}
3838	case f_beg:
3839	case instr_beg:
3840	case left_beg:
3841	case right_beg:
3842	case mid_beg:
3843	case replac_beg:
3844	#if CI_XMLELEM
3845	case xmlelem_beg:
3846	#endif
3847	case ss_beg: /A10/
3848	case datex_beg:
3849	{
3850	save_context(modify_fmt_pointers);
3851	IFERR_GOTO;
3852	ni=(l_code *) next_infoi(ni);
3853	break;
3854	}
3855
3856	case datex_end:
3857	{
3858	char *tmpch;
3859	fd_value[0]=null_char;
3860	auxpop = pop(); IFERR_GOTO;
3861	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3862	is_numeric(top->classe);
3863	IFERR_GOTO;
3864	float_exp_value = fmt_cnv_to_float(top);
3865	tmpch=fmt_get_date(0,float_exp_value);
3866	if(is_upper_mode(actual_mode)) upcase_mode(tmpch);
3867	/*
3868	tmpch=store_tmp_string(tmp_ptr);
3869	IFERR_GOTO;
3870	*/
3871	restore_context();
3872	IFERR_GOTO;
3873	elem.op.s=tmpch;
3874	elem.classe=string;
3875	push(&elem);
3876	IFERR_GOTO;
3877	ni=(l_code *) next_infoi(ni);
3878	break;
3879	}
3880
3881	case f_end: /* SVD alterado em 25/11/90 */
3882	{ /* retirar os tres parametros da pilha */
3883	char *tmpch;
3884	fd_value[0]=null_char;
3885	/* AOT - Correcao SVD 21/08/90 */
3886	auxpop = pop(); IFERR_GOTO;
3887	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3888	is_not_of_class(top->classe,long_n);
3889	IFERR_GOTO;
3890	is_numeric(top->classe);
3891	IFERR_GOTO;
3892	dec_places=(int)top->op.l;
3893
3894	auxpop = pop(); IFERR_GOTO;
3895	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3896	is_not_of_class(top->classe,long_n);
3897	IFERR_GOTO;
3898	is_numeric(top->classe);
3899	IFERR_GOTO;
3900	min_width=(int)top->op.l;
3901
3902
3903	auxpop = pop(); IFERR_GOTO;
3904	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
3905	is_numeric(top->classe);
3906	IFERR_GOTO;
3907	float_exp_value = fmt_cnv_to_float(top);
3908	#if DEB_FLOAT
3909	printf("\n++Antes de formatar out=");
3910	for (i=0;i<=pout;i++)printf("%c",out+i);
3911	printf("\|");
3912
3913	#endif
3914	#if MPE \|\| VAX \|\| UNIX
3915	tmpch=fmt_float_numb(float_exp_value,min_width,dec_places,space_char);
3916	#else
3917	tmpch=fmt_float_numb(float_exp_value,min_width,dec_places,space_char);
3918	#endif
3919
3920	#if DEB_FLOAT
3921	printf("\n++Apos formatar out=");
3922	for (i=0;i<=pout;i++)printf("%c",out+i);
3923	printf("\|");
3924
3925	printf("\ntmpch=%s\|",tmpch);
3926	#endif
3927
3928	restore_context();
3929	IFERR_GOTO;
3930	tmp_ptr=store_tmp_string(tmpch);
3931	IFERR_GOTO;
3932	elem.op.s=tmp_ptr;
3933	elem.classe=string;
3934	push(&elem);
3935	IFERR_GOTO;
3936
3937	/* strcpy(out,ss); agora ja gerou um print-string,load-string ou nada */
3938	ni=(l_code *) next_infoi(ni);
3939	break;
3940	}
3941	case s_beg:
3942	case getenv_beg:
3943	case putenv_beg:
3944	case citype_beg:
3945	case cat_beg:
3946	case nl_beg:
3947	case sattrib_beg:
3948	case type_beg:
3949	{
3950	save_context(modify_fmt_pointers);
3951	IFERR_GOTO;
3952	ni=(l_code *) next_infoi(ni);
3953	break;
3954	}
3955
3956	case s_end:
3957	{
3958	restore_context();
3959	IFERR_GOTO;
3960	/* substring em S */
3961	itf=(field_definition_node *) iadd(ni);
3962	if(itf->offset!= -1 && itf->length!= -1)
3963	strcpy(tmp_ptr,sub_string(tmp_ptr,itf->offset,itf->length));
3964	tmp_ptr=store_tmp_string(tmp_ptr);
3965	IFERR_GOTO;
3966	out[pout]=null_char;
3967	elem.op.s=tmp_ptr;
3968	elem.classe=string;
3969	push(&elem);
3970	IFERR_GOTO;
3971	ni=(l_code *) next_infoi(ni);
3972	break;
3973	}
3974
3975	case sattrib_end:
3976	{ char *q;
3977	int ind;
3978	restore_context();
3979	IFERR_GOTO;
3980	ind= (int)iadd(ni);
3981	fmt_free_S(ind,ind);
3982	q=strdup(tmp_ptr); /??? como testar retorno /
3983	IFERR_GOTO;
3984	S_var[ind] = q;
3985	#if DEB_ATTRIB
3986	printf("\ntmp_ptr=\|%s\|,S_var[%d]=%s",tmp_ptr,(int)iadd(ni),S_var[(int) iadd(ni)]);
3987	#endif
3988	out[pout]=null_char;
3989
3990	ni=(l_code *) next_infoi(ni);
3991	break;
3992	}
3993	case strvvalue:
3994	{ char *t;
3995	t=store_tmp_string(S_var[(int) iadd(ni)]);
3996	elem.op.s=t;
3997	elem.classe=string;
3998	push(&elem);
3999	IFERR_GOTO;
4000	ni=(l_code *) next_infoi(ni);
4001	break;
4002	}
4003
4004	case getenv_end:
4005	{
4006	char *ep;
4007	restore_context();
4008	IFERR_GOTO;
4009	/* substring em S */
4010	itf=(field_definition_node *) iadd(ni);
4011	ep=NULL; if (tmp_ptr) ep=getenv(tmp_ptr); / AOT 04/03/97 */
4012	if (ep) {
4013	tmp_ptr=store_tmp_string(ep);
4014	}
4015	else
4016	if (strncmp(tmp_ptr,"tmp=",4) == 0) {
4017	tmp_ptr+=4; /* tmp= */
4018	ep=dbxtmpnm(NULL/"CI_TEMPDIR"/,0,tmp_ptr);
4019	tmp_ptr=store_tmp_string(ep);
4020	}
4021	#if CICGI /* get cgi - AOT 12/09/2000 */
4022	else
4023	if (strncmp(tmp_ptr,"cgi=",4) == 0) {
4024	#if CICPP
4025	//CGIClass *cgi = new CGIClass(cisisxp);
4026	//cgi->cicgi0(NULL, NULL, &wwwp, (UWORD)1, "tag"); /* H1 10 ^ndbn^vcdsH1 10 ^ncount^v2H1 7 ^nnow^vH1 10 ^nbtell^v0H1 20 ^nbool^vplantswaterH1 15 ^npft^vmfn/v24/ /
4027	//delete cgi;
4028	#else /* CICPP */
4029	#if CIWTF /* WTFUN support */
4030	tmp_ptr+=4; /* cgi= */
4031	if (!ciahcgi) {
4032	char *wwwp=NULL;
4033	cicgi0(NULL, NULL, &wwwp, (UWORD)2000, "tag"); /* H2000 10 ^ndbn^vcdsH2000 10 ^ncount^v2H2000 7 ^nnow^vH2000 10 ^nbtell^v0H2000 20 ^nbool^vplantswaterH2000 15 ^npft^vmfn/v24/ /
4034	ciahcgi=wwwp;
4035	}
4036	if (ciahcgi) {
4037	char *p,cnam[3+LE2+2+1]; //.^nxxx^v
4038	int cnamlen;
4039	if (strlen(tmp_ptr)>LE2) tmp_ptr[LE2]='\0'; sprintf(cnam," ^n%s^v",tmp_ptr); cnamlen=strlen(cnam);
4040	for (p=ciahcgi; (p=strstr(p,"H2000 ")) != NULL; ) {
4041	int s;
4042	char k;
4043	p+=6; for (s=0; p && isdigit(p); p++) s=s10+(int)(p)-(int)'0';
4044	if (!s) continue;
4045	if (strncmp(p,cnam,cnamlen)) continue;
4046	p+=cnamlen; ep=p;
4047	k=ep[s]; ep[s]='\0'; tmp_ptr=store_tmp_string(ep); ep[s]=k;
4048	break;
4049	}
4050	}
4051	#else /* CIWTF */
4052	static char *fmtwwwp=NULL;
4053	char *wwwp=NULL;
4054	int len,qn=0;
4055	FFI ffilen;
4056	char p,vp,*q;
4057	tmp_ptr+=4; /* cgi= */
4058	if (!fmtwwwp) {
4059	cicgi0(NULL, NULL, &wwwp, (UWORD)1, "tag"); /* H1 10 ^ndbn^vcdsH1 10 ^ncount^v2H1 7 ^nnow^vH1 10 ^nbtell^v0H1 20 ^nbool^vplantswaterH1 15 ^npft^vmfn/v24/ /
4060	fmtwwwp=wwwp;
4061	}
4062	wwwp=fmtwwwp;
4063	for (q=p=wwwp; *p; ) {
4064	if (p++ != 'H') break; if (p++ != '1') break; if (*p++ != ' ') break;
4065	len=atoi(p); while(isdigit(p)) p++; if (len < 5) break; if (p++ != ' ') break;
4066	ffilen=(FFI)len; vp=(char )subfldp((unsigned char )p,'v',&ffilen); if (!vp) break;
4067	*(vp-2)='\0';
4068	if (strcmp(p+2,tmp_ptr) == 0) {
4069	/* if (!ffilen) ep=p+2; else { ep=vp; ep[ffilen]='\0'; } break; */
4070	if (!ffilen) { ep=p+2; ffilen=strlen(ep); } else ep=vp;
4071	if (qn) q++='%'; strncpy(q,ep,ffilen); q+=ffilen; q='\0'; qn++;
4072	}
4073	p+=len;
4074	}
4075	if (qn) strcpy(ep=tmp_ptr,wwwp);
4076	tmp_ptr=store_tmp_string(ep);
4077	#endif /* CIWTF */
4078	#endif /* CICPP */
4079	}
4080	#endif /* get cgi - AOT 12/09/2000 */
4081	if (!ep) tmp_ptr=store_tmp_string(ep);
4082	IFERR_GOTO;
4083	out[pout]=null_char;
4084	elem.op.s=tmp_ptr;
4085	elem.classe=string;
4086	push(&elem);
4087	IFERR_GOTO;
4088	ni=(l_code *) next_infoi(ni);
4089	break;
4090	}
4091
4092	case putenv_end:
4093	{
4094	char *ep;
4095	restore_context();
4096	IFERR_GOTO;
4097	/* substring em S */
4098	itf=(field_definition_node *) iadd(ni);
4099	#if BEFORE20000913
4100	/* bug: vai alocar e nao liberar antes do fim de exec. - AOT 03/09/97 */
4101	ep=NULL; if (*tmp_ptr) ep=putenv(strdup(tmp_ptr)) ? tmp_ptr : NULL;
4102	#else
4103	ep=NULL;
4104	if (*tmp_ptr) {
4105	char ip,op;
4106	ip=strchr(tmp_ptr,'=');
4107	if (ip) {
4108	ip='\0'; op=getenv(tmp_ptr); ip='=';
4109	if (op) {
4110	char c;
4111	/* To delete the variable from the environment, use getenv("name=") */
4112	ip++; c= ip; ip='\0'; getenv(tmp_ptr); *ip=c;
4113	}
4114	}
4115	ep=putenv(strdup(tmp_ptr)) ? tmp_ptr : NULL;
4116	}
4117	#endif
4118	tmp_ptr=store_tmp_string(ep);
4119	IFERR_GOTO;
4120	out[pout]=null_char;
4121	elem.op.s=tmp_ptr;
4122	elem.classe=string;
4123	push(&elem);
4124	IFERR_GOTO;
4125	ni=(l_code *) next_infoi(ni);
4126	break;
4127	}
4128
4129	case citype_end:
4130	{
4131	char *tt;
4132	restore_context(); /* Temporario tem que analizar o resultado */
4133	IFERR_GOTO;
4134	tt=fmt_type(tmp_ptr);
4135	tmp_ptr=store_tmp_string(tt);
4136	IFERR_GOTO;
4137	out[pout]=null_char;
4138	elem.op.s=tmp_ptr;
4139	elem.classe=string;
4140	push(&elem);
4141	IFERR_GOTO;
4142	ni=(l_code *) next_infoi(ni);
4143	break;
4144	}
4145
4146	case type_end:
4147	{
4148	LONGX rr ;
4149	rr=0;
4150	/* pattern ou valor numerico */
4151	auxpop = pop(); IFERR_GOTO;
4152	op1=(stack_node *)memcpy(&op1_node,auxpop,sizeof(stack_node));
4153
4154	/* como deve ser interpretado o operador 1 */
4155	auxpop = pop(); IFERR_GOTO;
4156	op2=(stack_node *)memcpy(&op2_node,auxpop,sizeof(stack_node));
4157	is_not_of_class(op2->classe,long_n);
4158	IFERR_GOTO;
4159	tmp_ptr= &out[0];
4160	if(op2->op.l == TYPE_PATTERN ){
4161	rr = fmt_type_pattern(op1->op.s,tmp_ptr);
4162	}else {
4163	if ( op2->op.l == TYPE_NUM ){
4164	rr = fmt_type_number(op1->op.l,tmp_ptr);
4165	}
4166
4167	}
4168	restore_context();
4169	IFERR_GOTO;
4170
4171	out[pout]=null_char;
4172	elem.op.l=rr;
4173	elem.classe=long_n;
4174	push(&elem);
4175	IFERR_GOTO;
4176	ni=(l_code *) next_infoi(ni);
4177	break;
4178	}
4179
4180	case cat_end:
4181	{
4182	/* Para poder usar cat como funcao e como elemento de formato
4183	e' necessario gerar um resultado para ser testado ou formatado
4184	na proxima instrucao. Por enquanto um valor "\0" esta sendo
4185	armzenado. Os testes de if nao funcionarao porque sempre
4186	sera esse valor armazenado. Deve ser discutido com AOT/ABEL
4187	Solucao: No cifm1
4188	- Quando for elemento gerar "\0" .
4189	- Quando for if/expre/ gerar 0 se erro e 1 se ok.
4190	*/
4191
4192	int fp;
4193	char ch[2];
4194	int keep_ordwr; /* AOT, 28/05/99 */
4195
4196	restore_context(); /* Temporario tem que analizar o resultado */
4197	IFERR_GOTO;
4198	if (strcmp(tmp_str,"+fields") == 0) {
4199	#if 0
4200	char line..
4201	ch[1]=null_char;
4202	while (CIREAD(fp,&ch[0],sizeof(char))> 0)
4203	out_put_str(out,outsize, &pout,lw_inter,0,0, &nextcc,(char *)&ch);
4204	#endif
4205	}
4206	else { /* AOT 05/10/02 */
4207	dbxopt_fatal=0;
4208	keep_ordwr=dbxopt_ordwr; dbxopt_ordwr=O_RDONLY; /* AOT 28/05/99 */
4209	fp=dbxopen(NULL,tmp_ptr,NULL);
4210	dbxopt_ordwr=keep_ordwr; /* AOT 28/05/99 */
4211	ch[1]=null_char;
4212	if (fp >= 0){
4213	while (CIREAD(fp,&ch[0],sizeof(char))> 0) {
4214	out_put_str(out,outsize, &pout,lw_inter,0,0, &nextcc,(char *)&ch);
4215	}
4216	CLOSE(fp);
4217	}else{
4218
4219	erro(1708);
4220	/* elem.op.s=store_tmp_string("\0"); */
4221	}
4222	} /* AOT 05/10/02 */
4223	IFERR_GOTO;
4224	out[pout]=null_char;
4225	elem.op.s=store_tmp_string("\0");
4226	elem.classe=string;
4227	push(&elem);
4228	IFERR_GOTO;
4229
4230	ni=(l_code *) next_infoi(ni);
4231	break;
4232	}
4233	case nl_end:
4234	{
4235	int len;
4236	restore_context(); /* Temporario tem que analizar o resultado */
4237	IFERR_GOTO;
4238	#if TRACESINDO
4239	printf("\n Valor gerado de tmp_ptr=\|%s\|",tmp_ptr);
4240	#endif
4241	len=strlen(tmp_ptr);
4242	if (len > nl_LEN) {
4243	#if CICPP
4244	delete [] (char *)nl_STR;
4245	#else
4246	FREE(nl_STR);
4247	#endif
4248	nl_STR=fmt_alloc_char((ALLOPARM)(len+1),"cifm3/alloc/nl_end");
4249	}
4250	/* strcpy((char )nl_STR,(char )tmp_ptr); */
4251	/* sprintf((char )nl_STR,(char )tmp_ptr,""); Nao funcionou porque
4252	(eu acho) que o c traduz \n diretamente para 1 caracter e nao
4253	dois carcteres \ seguido de n */
4254	#if 1
4255	sc((char *)tmp_ptr);
4256	#endif
4257	strcpy(nl_STR,tmp_ptr);
4258	nl_LEN=strlen(nl_STR);
4259	#if TRACESINDO
4260	printf("\n Novo Valor gerado de nl_STR=\|%s\|",(char *)nl_STR);
4261	#endif
4262
4263	out[pout]=null_char;
4264	ni=(l_code *) next_infoi(ni);
4265	break;
4266	}
4267
4268	case dbname_beg:
4269	{
4270	save_context(modify_fmt_pointers);
4271	IFERR_GOTO;
4272	ni=(l_code *) next_infoi(ni);
4273	break;
4274	}
4275
4276	case dbname_end:
4277	{
4278	restore_context();
4279	IFERR_GOTO;
4280	tmp_ptr=store_tmp_string(tmp_ptr);
4281	IFERR_GOTO;
4282	out[pout]=null_char;
4283	elem.op.s=tmp_ptr;
4284	elem.classe=string;
4285	push(&elem);
4286	IFERR_GOTO;
4287	ni=(l_code *) next_infoi(ni);
4288	break;
4289	}
4290
4291	case str_cat:
4292	{
4293	auxpop = pop(); IFERR_GOTO;
4294	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
4295	is_not_of_class(top->classe,string);
4296	IFERR_GOTO;
4297	out_put_str(out,outsize, &pout,lw_inter,0,0, &nextcc,top->op.s);
4298	ni=(l_code *) next_infoi(ni);
4299	break;
4300	}
4301	case prt_str_f:
4302	{
4303
4304	/* Quem chama deve inicializar os pointers de acordo . Acho que o nextcc
4305	tem que ser sempre o mesmo entre todas as chamadas. Quem deve tomar
4306	conta e o usuario. Inicialmente eu achava que ao retornar deveria
4307	formatar nas condicoes que estava ANTEs da chamada , mas agora acho que
4308	tem apenas que concatenar . Ver no isis e depois testar
4309
4310	out_put_str(out,outsize, &pout,lw_inter,0,0, &nextcc,top->op.s);
4311	*/
4312	/* strcat(out,top->op.s); / / SVD correcao 20/11/90*/
4313
4314	/* nextcc=deve_ser o ultimo chamado; */
4315	auxpop = pop(); IFERR_GOTO;
4316	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
4317	is_not_of_class(top->classe,string);
4318	IFERR_GOTO;
4319	#if DEB_FLOAT
4320	printf("\n--Desempilhou=%s\|",top->op.s);
4321	printf("\n--out=%s\|",out);
4322	#endif
4323	out_put_str(out,outsize, &pout,lw_inter,0,0, &nextcc,top->op.s);
4324
4325	ni=(l_code *) next_infoi(ni);
4326	break;
4327	}
4328	/* case load_str_f: */
4329
4330	case rsum_beg:
4331	case ravr_beg:
4332	case rmin_beg:
4333	case rmax_beg:
4334	case val_beg:
4335	case size_beg:
4336	case eattrib_beg:
4337	{
4338	save_context(modify_fmt_pointers);
4339	IFERR_GOTO;
4340	ni=(l_code *) next_infoi(ni);
4341	break;
4342	}
4343	case rsum_end:
4344	case ravr_end:
4345	{ float_x sum;
4346	#if !PC
4347	float_x x;
4348	#endif
4349	int k;
4350
4351	restore_context();
4352	IFERR_GOTO;
4353	sum=(float_x ) 0;
4354	i=0;
4355	k=0;
4356	pstr_num=find_numeric_string(tmp_ptr,&i);
4357	while ((size_t)strlen(pstr_num)>(size_t)0 )
4358	{
4359	k++;
4360	/* HB 20080901 - a funcao fmt_float_numb nao converte corretamente se float_x for float
4361	#if PC
4362	*/
4363	#if 1
4364	sum=sum+ (float_x) atof(pstr_num);
4365	#else
4366	sscanf(pstr_num,float_x_fmt,&x);
4367	sum=sum+ x;
4368	#endif
4369	pstr_num=find_numeric_string(tmp_ptr,&i);
4370	}
4371
4372	if (infoi(ni)==ravr_end && k!=0)sum=sum/k;
4373
4374	elem.op.r=sum;
4375	elem.classe=float_n;
4376	push(&elem);
4377	IFERR_GOTO;
4378
4379	out[pout]=null_char;
4380	ni=(l_code *) next_infoi(ni);
4381	break;
4382	}
4383	case rmin_end:
4384	case rmax_end:
4385	{
4386	float_x sum,min_value,max_value;
4387
4388	restore_context();
4389	IFERR_GOTO;
4390	i=0;
4391	pstr_num=find_numeric_string(tmp_ptr,&i);
4392	/* HB 20080901 - a funcao fmt_float_numb nao converte corretamente se float_x for float
4393	#if PC
4394	*/
4395	#if 1
4396	sum=(float_x) atof(pstr_num);
4397	#else
4398	sscanf(pstr_num,float_x_fmt,&sum);
4399	#endif
4400	min_value=sum;
4401	if (infoi(ni)==rmax_end) max_value=sum;
4402	while ((size_t)strlen(pstr_num)>(size_t)0 )
4403	{
4404	/* HB 20080901 - a funcao fmt_float_numb nao converte corretamente se float_x for float
4405	#if PC
4406	*/
4407	#if 1
4408	sum=(float_x) atof(pstr_num);
4409	#else
4410	sscanf(pstr_num,float_x_fmt,&sum);
4411	#endif
4412	if( infoi(ni)==rmin_end && min_value>sum)min_value=sum;
4413	if( infoi(ni)==rmax_end && max_value<sum)max_value=sum;
4414	pstr_num=find_numeric_string(tmp_ptr,&i);
4415	}
4416	elem.op.r=min_value;
4417	if (infoi(ni)==rmax_end) elem.op.r=max_value;
4418	elem.classe=float_n;
4419	push(&elem);
4420	IFERR_GOTO;
4421
4422	out[pout]=null_char;
4423	ni=(l_code *) next_infoi(ni);
4424	break;
4425	}
4426	case val_end:
4427	{
4428	/*
4429	auxpop = pop(); IFERR_GOTO;
4430	top=(stack_node *)memcpy(&top_node,auxpop,sizeof(stack_node));
4431	is_not_of_class(top->classe,string)
4432	IFERR_GOTO;
4433	*/
4434	tmp_ptr=out;
4435	i=0; /* pointer inicial dentro da string */
4436	pstr_num=find_numeric_string(tmp_ptr,&i);
4437	/* HB 20080901 - a funcao fmt_float_numb nao converte corretamente se float_x for float
4438	#if PC
4439	*/
4440	#if 1
4441	elem.op.r=(float_x) atof(pstr_num);
4442	#else
4443	sscanf(pstr_num,float_x_fmt,&(elem.op.r));
4444	/* elem.op.r = strtod(pstr_num,NULL); */
4445	#endif
4446	elem.classe=float_n;
4447
4448	restore_context();
4449	IFERR_GOTO;
4450	out[pout]=null_char;
4451	push(&elem);
4452	IFERR_GOTO;
4453
4454	ni=(l_code *) next_infoi(ni);
4455	break;
4456	}
4457
4458	case size_end:
4459	{
4460	//elem.op.l= (LONGX ) strlen(out);
4461	elem.op.l= (LONGX ) strlen_UTF8(out);
4462	elem.classe=long_n;
4463	restore_context();
4464	IFERR_GOTO;
4465	push(&elem);
4466	IFERR_GOTO;
4467	out[pout]=null_char;
4468	ni=(l_code *) next_infoi(ni);
4469	break;
4470	}
4471
4472	case eattrib_end:
4473	{
4474	float_x x;
4475	auxpop = pop(); IFERR_GOTO;
4476	x = convert_to_float(auxpop);
4477	E_var[(int) iadd(ni)]= x;
4478
4479	restore_context();
4480	IFERR_GOTO;
4481	out[pout]=null_char;
4482	ni=(l_code *) next_infoi(ni);
4483	break;
4484	}
4485
4486	case end_rep_gr:
4487	{
4488	rep_group=false;
4489	next_rep_occ=0;
4490	ni=(l_code *) next_infoi(ni);
4491	break;
4492	}
4493	case beg_init_not_rep:
4494	{
4495	fmt_inicio_grupos_vfields(beg_init_not_rep,end_init_not_rep);
4496	IFERR_GOTO;
4497	ni=(l_code *)ni->next;
4498	break;
4499	}
4500	case end_init_not_rep:
4501	{
4502	fmt_fim_grupos_vfields();
4503	IFERR_GOTO;
4504
4505	#if TRACE_REPF
4506	printf("\n [out=]%s",out);
4507	printf("\n [End_init_not_rep <pop>] rep_goup=%d next_rep_occ=%d",
4508	rep_group,next_rep_occ);
4509	#endif
4510	ni=(l_code *)ni->next;
4511	break;
4512	}
4513	case beg_init_rep:
4514	{
4515	fmt_inicio_grupos_vfields(beg_init_rep,end_init_rep);
4516	IFERR_GOTO;
4517	#if DEB_NOCC
4518	printf("\n processando ocorrenci=%"_LD_,next_rep_occ);
4519	#endif
4520	ni=(l_code *)ni->next;
4521	break;
4522	}
4523	case end_init_rep:
4524	{
4525	fmt_fim_grupos_vfields();
4526	IFERR_GOTO;
4527	#if TRACE_REPF
4528	printf("\n [out=]%s",out);
4529	printf("\n [End_init_rep <pop>] rep_goup=%d next_rep_occ=%d",
4530	rep_group,next_rep_occ);
4531	#endif
4532	ni=(l_code *)ni->next;
4533	break;
4534	}
4535	/* Continue em grupos repetitivos 17-7-94 */
4536	case continueins:
4537	{
4538	continue_rgroup=true;
4539	ni=(l_code *)ni->next;
4540	break;
4541	}
4542	default:
4543	{
4544	ni=(l_code *) next_infoi(ni);
4545	break;
4546	}
4547	} /* switch */
4548	if (ni==nulo) fim_pgm=true;
4549	} /* while */
4550
4551
4552	/* Liberacao das maiores areas originalmente estaticas - AOT 29/12/90 */
4553	#if DINALLOC
4554	#if CICPP
4555	delete [] (char *)tmp_str;
4556	delete [] (char *)v_fd_value;
4557	delete [] (char *)v_fd_tmp;
4558	/A06/
4559	if (literal !=NULL) delete [] (char *)literal;
4560	/A07/
4561	lineqtt = number_of_lines(out); /* RPIVA - use nl_STR before FREE */
4562	delete [] (char *)nl_STR;
4563	#else /* CICPP */
4564	FREE(tmp_str);
4565	FREE(v_fd_value);
4566	FREE(v_fd_tmp);
4567	/A06/
4568	if (literal != NULL) {
4569	FREE(literal);
4570	}
4571	#if BEFORE20000405
4572	fmt_free_S(0,NMAXVAR);
4573	#else
4574	fmt_free_S(0,NMAXVAR-1); /* AOT/HB - pois fmt_free_S assume from e to */
4575	#endif
4576	/A07/
4577	lineqtt = number_of_lines(out); /* RPIVA - use nl_STR before FREE */
4578	FREE(nl_STR);
4579	#endif /* CICPP */
4580	#endif
4581	if (fmttrace) printf("+++ fmt_inter - success \n"); /* AOT 27/12/91 */
4582
4583	if (erro_fatal==0 )
4584	{
4585	return (lineqtt);
4586	}
4587	else return(erro_fatal);
4588
4589	}
4590
4591	/-------------------------------------------------------------------------/
4592
4593	/--------------------------------------------------------------------------/
4594	/* inter_error */
4595	/--------------------------------------------------------------------------/
4596
4597	#if CICPP
4598	void FMTSTRU :: inter_error(char *err)
4599	#else /* CICPP */
4600	#if ANSI
4601	void inter_error(char *err)
4602	#else /* ANSI */
4603	void inter_error(err)
4604	char *err;
4605	#endif /* ANSI */
4606	#endif /* CICPP */
4607	{
4608	int errl;
4609	#if TRACE_REPF
4610	printf("\n *** INTER -%s",err);
4611	#endif
4612
4613	#if DINALLOC
4614	#if CICPP
4615	delete [] (char *)tmp_str;
4616	delete [] (char *)v_fd_value;
4617	delete [] (char *)v_fd_tmp;
4618	/A06/
4619	if (literal != NULL) delete [] (char *)literal;
4620	/A07/
4621	delete [] (char *)nl_STR;
4622	#else /* CICPP */
4623	FREE(tmp_str);
4624	FREE(v_fd_value);
4625	FREE(v_fd_tmp);
4626	/A06/
4627	if (literal != NULL) FREE(literal);
4628	/A07/
4629	FREE(nl_STR);
4630	#endif /* CICPP */
4631	#endif
4632
4633	errl=strlen(err);
4634	if (errl >= MAXERRL) errl=MAXERRL;
4635
4636	strncpy(fmterrxy,err,errl); fmterrxy[errl]='\0';
4637
4638	#if FATRAP
4639	longjmp(fmtjumper,-1);
4640	#else /* FATRAP */
4641	fmterror = -1;
4642	return;
4643	#endif /* FATRAP */
4644	fatal("inter_error"); /* just in case */
4645	}
4646
4647
4648	/* --------------------LOOKUP.C --------------------------------*/
4649
4650	#if CICPP
4651	LONGX FMTSTRU :: lookup(char *keyp,
4652	TRMSTRU *trmp,
4653	char *dbnp,
4654	LONGX nord)
4655	#else /* CICPP */
4656	#if ANSI
4657	LONGX lookup(char keyp,LONGX next_inverted_prat,char dbnp,LONGX nord)
4658	#else /* ANSI */
4659	LONGX lookup(keyp,next_inverted_prat,dbnp,nord)
4660	char *keyp;
4661	LONGX next_inverted_prat;
4662	char *dbnp;
4663	LONGX nord;
4664	#endif /* ANSI */
4665	#endif /* CICPP */
4666	{
4667	#if !CICPP
4668	TRMSTRU *trmp;
4669	#endif
4670	LONGX pmfn;
4671	pmfn=0;
4672	if (*keyp)
4673	{
4674	#define KEEPDBXT 0
4675	#if KEEPDBXT
4676	LONGX idbx,keepndbx=ndbxs;
4677	#endif /* KEEPDBXT */
4678	#if CICPP
4679	trmp->xterm((UCHR )dbnp,(UCHR )keyp);
4680	#else /* CICPP */
4681	TERM(next_inverted_prat,(UCHR )dbnp,(UCHR )keyp);
4682	#endif /* CICPP */
4683	if (TRMrc == RCNORMAL) {
4684	#if CICPP
4685	pmfn=trmp->xposting(nord);
4686	#else /* CICPP */
4687	pmfn=posting(next_inverted_prat,nord);
4688	#endif /* CICPP */
4689	}
4690	#define FMTIFLUSH 0
4691	#if FMTIFLUSH
4692	if (strcmp(firstdbnp,dbnp)) invflush(dbnp);
4693	#endif
4694	#if KEEPDBXT
4695	for (idbx=ndbxs-1; idbx>=keepndbx; idbx--)
4696	dbxflush(vdbxp[idbx]->dbxname);
4697	#endif /* KEEPDBXT */
4698	}
4699	return pmfn;
4700	}
4701
4702
4703
4704	/--------------------------------------------------------------------------/
4705	/* recfmt.c */
4706	/--------------------------------------------------------------------------/
4707
4708	#if !CICPP \|\| CIAPI_SOURCE
4709	#if CIAPI_SOURCE
4710	LONGX recfmtcmp(RECSTRU* recp, LONGX lw, char fmt, char area, LONGX asize,
4711	FMTSTRU **ptpgm, int flagfree)
4712	#else /* CIAPI_SOURCE */
4713	LONGX recfmtcmp (idx,lw,fmt,area,asize,ptpgm,flagfree)
4714	LONGX idx;
4715	LONGX lw;
4716	char *fmt;
4717	char *area;
4718	LONGX asize;
4719	l_code **ptpgm;
4720	int flagfree;
4721	#endif /* CIAPI_SOURCE */
4722	{
4723	LONGX lines;
4724	if (!*ptpgm)
4725	#if CIAPI_SOURCE
4726	if ((*ptpgm)->xfmt_gener(fmt)) {
4727	return (-(*ptpgm)->fmt_error);
4728	#else /* CIAPI_SOURCE */
4729	if (fmt_gener (ptpgm, fmt)) {
4730	return (-fmt_error);
4731	#endif /* CIAPI_SOURCE */
4732	/* printf ("\n Deu erro de formato"); */
4733	}
4734	#if PRINT_CODE
4735	/svd 15-05-92 / print_inter_din(fmt,*ptpgm);
4736	#endif
4737
4738	#if CIAPI_SOURCE
4739	lines = (*ptpgm)->xfmt_inter (recp, lw, area, asize);
4740	#else /* CIAPI_SOURCE */
4741	lines = fmt_inter (*ptpgm, idx, lw, area, asize);
4742	#endif /* CIAPI_SOURCE */
4743	if (flagfree) {
4744	#if CIAPI_SOURCE
4745	(*ptpgm)->xfmt_free();
4746	#else /* CIAPI_SOURCE */
4747	fmt_free (*ptpgm);
4748	*ptpgm = NULL;
4749	#endif /* CIAPI_SOURCE */
4750	}
4751	return (lines);
4752	}
4753
4754	#if CIAPI_SOURCE
4755	LONGX recfmt( RECSTRU* recp, LONGX lw, char fmt, char area, LONGX asize)
4756	#else /* CIAPI_SOURCE */
4757	LONGX recfmt (idx,lw,fmt,area,asize)
4758	LONGX idx;
4759	LONGX lw;
4760	char *fmt;
4761	char *area;
4762	LONGX asize;
4763	#endif /* CIAPI_SOURCE */
4764	{
4765	#if CIAPI_SOURCE
4766	FMTSTRU *lc = NULL;
4767	#else /* CIAPI_SOURCE */
4768	l_code *lc = NULL;
4769	#endif /* CIAPI_SOURCE */
4770	LONGX n;
4771	#if TESTFREE
4772	unsigned LONGX m1,m2,x;
4773	UCHR pantes,pdepois;
4774
4775	pantes= (UCHR *)ALLOC((ALLOPARM) sizeof(UCHR));
4776	cprintf("pantesALL(%Fp)\n",pantes);getch();
4777
4778	m1 = CORELEFT();
4779	#if CIAPI_SOURCE
4780	n=recfmtcmp(recp, lw, fmt, area, asize, &lc, 1);
4781	#else /* CIAPI_SOURCE */
4782	n=recfmtcmp(idx, lw, fmt, area, asize, &lc, 1);
4783	#endif /* CIAPI_SOURCE */
4784
4785	m2 = CORELEFT();
4786	x = m1-m2;
4787	pdepois= (UCHR *)ALLOC((ALLOPARM) sizeof(UCHR));
4788	cprintf("pdepois ALL(%Fp)\n Diferenca=%lu",pdepois,
4789	(unsigned)pdepois-(unsigned)pantes);getch();
4790	FREE(pantes);
4791	FREE(pdepois);
4792	if (m1 != m2) {
4793	clrscr();
4794	cprintf("\n\r*** coreleft=%lu-%lu=%lu\n\rfmt:\n\r%s", m1, m2, x ,fmt);
4795	}
4796	#else
4797	#if CIAPI_SOURCE
4798	n=recfmtcmp(recp, lw, fmt, area, asize, &lc, 1);
4799	#else /* CIAPI_SOURCE */
4800	n=recfmtcmp(idx, lw, fmt, area, asize, &lc, 1);
4801	#endif /* CIAPI_SOURCE */
4802	#endif
4803	return (n);
4804	}
4805	#endif /* CICPP \|\| CIAPI_SOURCE */
4806
4807	#if CICPP
4808	FMTSTRU :: FMTSTRU (CISISX *cpx)
4809	{
4810	cisisxp = cpx;
4811
4812	//---------------------- CIFM1.C ----------------------------------
4813	fmt_pgmp = NULL;
4814	separa_nome_base=0;
4815	string_length=MAX_LITER;
4816	classe_numero_procurado=0;
4817	nopn_fmtfiles= -1;
4818	ch = space_char;
4819	sub_field_value = 0;
4820	source_index=0;
4821	last_source_index=0;
4822	fmt_error=0;
4823	#if ERRORET
4824	fmt_errof=0;
4825	#endif
4826	p_nulo=nulo;
4827	top_repeat=0;
4828	last_format=is_not_rep;
4829	pf_look_ahead= -1;
4830	pi_look_ahead=0;
4831	buff_look_ahead=NULL;
4832	LOOKING_AHEAD=0;
4833	first_time=1;
4834
4835	//---------------------- CIFM3.C ----------------------------------
4836	memset(fmterrxy, 0x00, sizeof(fmterrxy));
4837	#if DINALLOC
4838	fmt_fsiz = MAXMFRL;
4839	#else /* DINALLOC */
4840	max_tmp_str=MAX_TMP_STR;
4841	max_fd_value=MAX_FD_VALUE;
4842	max_fd_tmp=MAX_FD_TMP;
4843	#endif /* DINALLOC */
4844	modify_fmt_pointers=true;
4845	no_modify_fmt_pointers=false;
4846
4847	/*
4848	tb_espec[0]={"\\r",'\r'};
4849	tb_espec[1]={"\\t",'\t'};
4850	tb_espec[2]={"\\b",'\b'};
4851	tb_espec[3]={"\\n",'\n'};
4852	tb_espec[4]={"\\0",'\0'}; */
4853
4854	strcpy(tb_espec[0].s_esp, "\\r");
4855	tb_espec[0].c_esp = '\r'; /* 'R' */
4856	strcpy(tb_espec[1].s_esp, "\\t");
4857	tb_espec[1].c_esp = '\t'; /* 'T' */
4858	strcpy(tb_espec[2].s_esp, "\\b");
4859	tb_espec[2].c_esp = '\b'; /* 'B' */
4860	strcpy(tb_espec[3].s_esp, "\\n");
4861	tb_espec[3].c_esp = '\n'; /* 'N' */
4862	strcpy(tb_espec[4].s_esp, "\\0");
4863	tb_espec[4].c_esp = '\0'; /* '0' */
4864	}
4865
4866	#if 0
4867	FMTSTRU :: FMTSTRU(void): fmt_pgmp(NULL),
4868	#if NACLASSE
4869	fmt_error(0), fmt_errof(0) ,
4870	#endif
4871	fmt_fsiz(MAXMFRL) {};
4872	#endif // 0
4873
4874	FMTSTRU :: ~FMTSTRU(void)
4875	{
4876	xfmt_free();
4877	}
4878
4879	#endif /* CICPP */

Note: See TracBrowser for help on using the browser.

Context Navigation

root/trunk/cifm3_unicode.c

Download in other formats: