Attachment #10633 for bug #21276

View | Details | Raw Unified | Return to bug 21276
Collapse All | Expand All




integer f_back(alist *a)
#endif
{	unit *b;
	f77_offset v, w, x, y, z;
	uiolen n;
	FILE *f;


	f = b->ufd;	/* may have changed in t_runc() */
	if(b->url>0)
	{
		x=FTELL(f);
		y = x % b->url;
		if(y == 0) x--;
		x /= b->url;
		x *= b->url;
		(void) FSEEK(f,x,SEEK_SET);
		return(0);
	}

	if(b->ufmt==0)
	{	FSEEK(f,-(long)sizeof(uiolen),SEEK_CUR);
		fread((char *)&n,sizeof(uiolen),1,f);
		FSEEK(f,-(f77_offset)n-2*sizeof(uiolen),SEEK_CUR);
		return(0);
	}
	w = x = FTELL(f);
	z = 0;
 loop:
	while(x) {
		x -= x < 64 ? x : 64;
		FSEEK(f,x,SEEK_SET);
		for(y = x; y < w; y++) {
			if (getc(f) != '\n')
				continue;
			v = FTELL(f);
			if (v == w) {
				if (z)
					goto break2;

		err(a->aerr,(EOF),"backspace")
		}
 break2:
	FSEEK(f, z, SEEK_SET);
	return 0;
}

Lines 81-87 Link Here

(-)dfe.c (-1 / +1 lines)
81	f__fmtbuf=a->cifmt;	81	f__fmtbuf=a->cifmt;
82	if(a->cirec <= 0)	82	if(a->cirec <= 0)
83	err(a->cierr,130,"dfe")	83	err(a->cierr,130,"dfe")
84	fseek(f__cf,(long)f__curunit->url * (a->cirec-1),SEEK_SET);	84	FSEEK(f__cf,(f77_offset)f__curunit->url * (a->cirec-1),SEEK_SET);
85	f__curunit->uend = 0;	85	f__curunit->uend = 0;
86	return(0);	86	return(0);
87	}	87	}

Lines 21-27 Link Here

(-)due.c (-3 / +3 lines)
21	if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue")	21	if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue")
22	if(a->cirec <= 0)	22	if(a->cirec <= 0)
23	err(a->cierr,130,"due")	23	err(a->cierr,130,"due")
24	fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET);	24	FSEEK(f__cf,(f77_offset)(a->cirec-1)*f__curunit->url,SEEK_SET);
25	f__curunit->uend = 0;	25	f__curunit->uend = 0;
26	return(0);	26	return(0);
27	}	27	}
Lines 55-62 Link Here
55	{	55	{
56	if(f__curunit->url==1 \|\| f__recpos==f__curunit->url)	56	if(f__curunit->url==1 \|\| f__recpos==f__curunit->url)
57	return(0);	57	return(0);
58	fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR);	58	FSEEK(f__cf,(f77_offset)(f__curunit->url-f__recpos),SEEK_CUR);
59	if(ftell(f__cf)%f__curunit->url)	59	if(FTELL(f__cf)%f__curunit->url)
60	err(f__elist->cierr,200,"syserr");	60	err(f__elist->cierr,200,"syserr");
61	return(0);	61	return(0);
62	}	62	}




t_runc(alist *a)
#endif
{
	f77_offset loc, len;
	unit *b;
	FILE *bf, *tf;
	int rc = 0;

	b = &f__units[a->aunit];
	if(b->url)
		return(0);	/*don't truncate direct files*/
	loc=FTELL(bf = b->ufd);
	FSEEK(bf,0L,SEEK_END);
	len=FTELL(bf);
	if (loc >= len || b->useek == 0 || b->ufnm == NULL)
		return(0);
	fclose(b->ufd);

		fclose(bf);
		if (!(bf = fopen(b->ufnm, f__w_mode[3])))
			goto bad;
		FSEEK(bf,0L,SEEK_END);
		b->urw = 3;
		}
#endif




f__nowreading(unit *x)
#endif
{
	f77_offset loc;
	int ufmt, urw;
	extern char *f__r_mode[], *f__w_mode[];


	if (!x->ufnm)
		goto cantread;
	ufmt = x->url ? 0 : x->ufmt;
	loc = FTELL(x->ufd);
	urw = 3;
	if (!freopen(x->ufnm, f__w_mode[ufmt|2], x->ufd)) {
		urw = 1;

			return 1;
			}
		}
	FSEEK(x->ufd,loc,SEEK_SET);
	x->urw = urw;
 done:
	x->uwrt = 0;

		x->urw = 2;
		}
	else {
		loc=FTELL(x->ufd);
		if (!(f__cf = x->ufd =
			freopen(x->ufnm, f__w_mode[ufmt |= 2], x->ufd)))
			{

			return(1);
			}
		x->urw = 3;
		FSEEK(x->ufd,loc,SEEK_SET);
		}
 done:
	x->uwrt = 1;

Lines 6-12 Link Here

(-)f2c.h (-1 / +16 lines)
6		6
7	#ifndef F2C_INCLUDE	7	#ifndef F2C_INCLUDE
8	#define F2C_INCLUDE	8	#define F2C_INCLUDE
		9	#include <unistd.h>
9		10
		11	#ifndef F77_OFFSET
		12	typedef int f77_offset;
		13	#else
		14	typedef F77_OFFSET f77_offset;
		15	#endif
		16
10	typedef long int integer;	17	typedef long int integer;
11	typedef unsigned long uinteger;	18	typedef unsigned long uinteger;
12	typedef char *address;	19	typedef char *address;
Lines 36-41 Link Here
36		43
37	/* I/O stuff */	44	/* I/O stuff */
38		45
		46	#ifndef FSEEK
		47	#define FSEEK fseek
		48	#endif
		49
		50	#ifndef FTELL
		51	#define FTELL ftell
		52	#endif
		53
39	#ifdef f2c_i2	54	#ifdef f2c_i2
40	/* for -i2 */	55	/* for -i2 */
41	typedef short flag;	56	typedef short flag;
Lines 117-123 Link Here
117	char *inunf;	132	char *inunf;
118	ftnlen inunflen;	133	ftnlen inunflen;
119	ftnint *inrecl;	134	ftnint *inrecl;
120	ftnint *innrec;	135	f77_offset *innrec;
121	char *inblank;	136	char *inblank;
122	ftnlen inblanklen;	137	ftnlen inblanklen;
123	} inlist;	138	} inlist;




	return f__units[Unit].ufd;
	}

f77_offset
/* integer*/
#ifdef KR_headers
FTELL_(Unit) integer *Unit;
#else
FTELL_(integer *Unit)
#endif
{
	FILE *f;
	return (f = unit_chk(*Unit, "FTELL")) ? FTELL(f) : -1L;
	}

 int
#ifdef KR_headers
FSEEK_(Unit, offset, whence) integer *Unit, f77_offset *offset, integer *whence;
#else
FSEEK_(integer *Unit, f77_offset *offset, integer *whence)
#endif
{
	FILE *f;

#ifdef SEEK_SET
	w = wohin[w];
#endif
	return	!(f = unit_chk(*Unit, "FSEEK"))
		|| FSEEK(f, *offset, w) ? 1 : 0;
	}

Lines 100-106 Link Here

(-)inquire.c (-1 / +1 lines)
100	if(a->inrecl!=NULL && p!=NULL)	100	if(a->inrecl!=NULL && p!=NULL)
101	*a->inrecl=p->url;	101	*a->inrecl=p->url;
102	if(a->innrec!=NULL && p!=NULL && p->url>0)	102	if(a->innrec!=NULL && p!=NULL && p->url>0)
103	*a->innrec=ftell(p->ufd)/p->url+1;	103	*a->innrec=FTELL(p->ufd)/p->url+1;
104	if(a->inblank && p!=NULL && p->ufmt)	104	if(a->inblank && p!=NULL && p->ufmt)
105	if(p->ublnk)	105	if(p->ublnk)
106	b_char("ZERO",a->inblank,a->inblanklen);	106	b_char("ZERO",a->inblank,a->inblanklen);

Lines 5-11 Link Here

(-)makefile (-1 / +1 lines)
5		5
6	# compile, then strip unnecessary symbols	6	# compile, then strip unnecessary symbols
7	.c.o:	7	.c.o:
8	$(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c	8	$(CC) -c -DFSEEK=fseeko -DLSEEK=lseeko -DF77OFF=off_t -DSkip_f2c_Undefs $(CFLAGS) $*.c
9	ld -r -x -o $.xxx $.o	9	ld -r -x -o $.xxx $.o
10	mv $.xxx $.o	10	mv $.xxx $.o
11	## Under Solaris (and other systems that do not understand ld -x),	11	## Under Solaris (and other systems that do not understand ld -x),

Lines 266-272 Link Here

(-)open.c (-1 / +1 lines)
266	if (a->orl)	266	if (a->orl)
267	rewind(b->ufd);	267	rewind(b->ufd);
268	else if ((s = a->oacc) && (s == 'a' \|\| s == 'A')	268	else if ((s = a->oacc) && (s == 'a' \|\| s == 'A')
269	&& fseek(b->ufd, 0L, SEEK_END))	269	&& FSEEK(b->ufd, 0L, SEEK_END))
270	opnerr(a->oerr,129,"open");	270	opnerr(a->oerr,129,"open");
271	return(0);	271	return(0);
272	}	272	}




#include "f2c.h"
#include "fio.h"
extern uiolen f__reclen;
f77_offset f__recloc;

#ifdef KR_headers
c_sue(a) cilist *a;

	f__reclen=0;
	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
		err(a->cierr, errno, "write start");
	f__recloc=FTELL(f__cf);
	(void) FSEEK(f__cf,(long)sizeof(uiolen),SEEK_CUR);
	return(0);
}
integer e_wsue(Void)
{	f77_offset loc;
	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
#ifdef ALWAYS_FLUSH
	if (fflush(f__cf))
		err(f__elist->cierr, errno, "write end");
#endif
	loc=FTELL(f__cf);
	FSEEK(f__cf,f__recloc,SEEK_SET);
	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
	FSEEK(f__cf,loc,SEEK_SET);
	return(0);
}
integer e_rsue(Void)
{
	(void) FSEEK(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR);
	return(0);
}

Return to bug 21276

Lines 192-198 Link Here

(-)err.c (-5 / +5 lines)
192	f__nowreading(unit *x)	192	f__nowreading(unit *x)
193	#endif	193	#endif
194	{	194	{
195	long loc;	195	f77_offset loc;
196	int ufmt, urw;	196	int ufmt, urw;
197	extern char f__r_mode[], f__w_mode[];	197	extern char f__r_mode[], f__w_mode[];
198		198
Lines 201-207 Link Here
201	if (!x->ufnm)	201	if (!x->ufnm)
202	goto cantread;	202	goto cantread;
203	ufmt = x->url ? 0 : x->ufmt;	203	ufmt = x->url ? 0 : x->ufmt;
204	loc = ftell(x->ufd);	204	loc = FTELL(x->ufd);
205	urw = 3;	205	urw = 3;
206	if (!freopen(x->ufnm, f__w_mode[ufmt\|2], x->ufd)) {	206	if (!freopen(x->ufnm, f__w_mode[ufmt\|2], x->ufd)) {
207	urw = 1;	207	urw = 1;
Lines 211-217 Link Here
211	return 1;	211	return 1;
212	}	212	}
213	}	213	}
214	fseek(x->ufd,loc,SEEK_SET);	214	FSEEK(x->ufd,loc,SEEK_SET);
215	x->urw = urw;	215	x->urw = urw;
216	done:	216	done:
217	x->uwrt = 0;	217	x->uwrt = 0;
Lines 239-245 Link Here
239	x->urw = 2;	239	x->urw = 2;
240	}	240	}
241	else {	241	else {
242	loc=ftell(x->ufd);	242	loc=FTELL(x->ufd);
243	if (!(f__cf = x->ufd =	243	if (!(f__cf = x->ufd =
244	freopen(x->ufnm, f__w_mode[ufmt \|= 2], x->ufd)))	244	freopen(x->ufnm, f__w_mode[ufmt \|= 2], x->ufd)))
245	{	245	{
Lines 249-255 Link Here
249	return(1);	249	return(1);
250	}	250	}
251	x->urw = 3;	251	x->urw = 3;
252	fseek(x->ufd,loc,SEEK_SET);	252	FSEEK(x->ufd,loc,SEEK_SET);
253	}	253	}
254	done:	254	done:
255	x->uwrt = 1;	255	x->uwrt = 1;

Lines 6-12 Link Here

(-)backspace.c (-9 / +9 lines)
6	integer f_back(alist *a)	6	integer f_back(alist *a)
7	#endif	7	#endif
8	{ unit *b;	8	{ unit *b;
9	long v, w, x, y, z;	9	f77_offset v, w, x, y, z;
10	uiolen n;	10	uiolen n;
11	FILE *f;	11	FILE *f;
12		12
Lines 30-60 Link Here
30	f = b->ufd; /* may have changed in t_runc() */	30	f = b->ufd; /* may have changed in t_runc() */
31	if(b->url>0)	31	if(b->url>0)
32	{	32	{
33	x=ftell(f);	33	x=FTELL(f);
34	y = x % b->url;	34	y = x % b->url;
35	if(y == 0) x--;	35	if(y == 0) x--;
36	x /= b->url;	36	x /= b->url;
37	x *= b->url;	37	x *= b->url;
38	(void) fseek(f,x,SEEK_SET);	38	(void) FSEEK(f,x,SEEK_SET);
39	return(0);	39	return(0);
40	}	40	}
41		41
42	if(b->ufmt==0)	42	if(b->ufmt==0)
43	{ fseek(f,-(long)sizeof(uiolen),SEEK_CUR);	43	{ FSEEK(f,-(long)sizeof(uiolen),SEEK_CUR);
44	fread((char *)&n,sizeof(uiolen),1,f);	44	fread((char *)&n,sizeof(uiolen),1,f);
45	fseek(f,-(long)n-2*sizeof(uiolen),SEEK_CUR);	45	FSEEK(f,-(f77_offset)n-2*sizeof(uiolen),SEEK_CUR);
46	return(0);	46	return(0);
47	}	47	}
48	w = x = ftell(f);	48	w = x = FTELL(f);
49	z = 0;	49	z = 0;
50	loop:	50	loop:
51	while(x) {	51	while(x) {
52	x -= x < 64 ? x : 64;	52	x -= x < 64 ? x : 64;
53	fseek(f,x,SEEK_SET);	53	FSEEK(f,x,SEEK_SET);
54	for(y = x; y < w; y++) {	54	for(y = x; y < w; y++) {
55	if (getc(f) != '\n')	55	if (getc(f) != '\n')
56	continue;	56	continue;
57	v = ftell(f);	57	v = FTELL(f);
58	if (v == w) {	58	if (v == w) {
59	if (z)	59	if (z)
60	goto break2;	60	goto break2;
Lines 65-70 Link Here
65	err(a->aerr,(EOF),"backspace")	65	err(a->aerr,(EOF),"backspace")
66	}	66	}
67	break2:	67	break2:
68	fseek(f, z, SEEK_SET);	68	FSEEK(f, z, SEEK_SET);
69	return 0;	69	return 0;
70	}	70	}

Lines 62-68 Link Here

(-)endfile.c (-5 / +5 lines)
62	t_runc(alist *a)	62	t_runc(alist *a)
63	#endif	63	#endif
64	{	64	{
65	long loc, len;	65	f77_offset loc, len;
66	unit *b;	66	unit *b;
67	FILE bf, tf;	67	FILE bf, tf;
68	int rc = 0;	68	int rc = 0;
Lines 70-78 Link Here
70	b = &f__units[a->aunit];	70	b = &f__units[a->aunit];
71	if(b->url)	71	if(b->url)
72	return(0); /don't truncate direct files/	72	return(0); /don't truncate direct files/
73	loc=ftell(bf = b->ufd);	73	loc=FTELL(bf = b->ufd);
74	fseek(bf,0L,SEEK_END);	74	FSEEK(bf,0L,SEEK_END);
75	len=ftell(bf);	75	len=FTELL(bf);
76	if (loc >= len \|\| b->useek == 0 \|\| b->ufnm == NULL)	76	if (loc >= len \|\| b->useek == 0 \|\| b->ufnm == NULL)
77	return(0);	77	return(0);
78	fclose(b->ufd);	78	fclose(b->ufd);
Lines 108-114 Link Here
108	fclose(bf);	108	fclose(bf);
109	if (!(bf = fopen(b->ufnm, f__w_mode[3])))	109	if (!(bf = fopen(b->ufnm, f__w_mode[3])))
110	goto bad;	110	goto bad;
111	fseek(bf,0L,SEEK_END);	111	FSEEK(bf,0L,SEEK_END);
112	b->urw = 3;	112	b->urw = 3;
113	}	113	}
114	#endif	114	#endif

Lines 13-34 Link Here

(-)ftell_.c (-8 / +9 lines)
13	return f__units[Unit].ufd;	13	return f__units[Unit].ufd;
14	}	14	}
15		15
16	integer	16	f77_offset
		17	/* integer*/
17	#ifdef KR_headers	18	#ifdef KR_headers
18	ftell_(Unit) integer *Unit;	19	FTELL_(Unit) integer *Unit;
19	#else	20	#else
20	ftell_(integer *Unit)	21	FTELL_(integer *Unit)
21	#endif	22	#endif
22	{	23	{
23	FILE *f;	24	FILE *f;
24	return (f = unit_chk(*Unit, "ftell")) ? ftell(f) : -1L;	25	return (f = unit_chk(*Unit, "FTELL")) ? FTELL(f) : -1L;
25	}	26	}
26		27
27	int	28	int
28	#ifdef KR_headers	29	#ifdef KR_headers
29	fseek_(Unit, offset, whence) integer Unit, offset, *whence;	30	FSEEK_(Unit, offset, whence) integer Unit, f77_offset offset, integer *whence;
30	#else	31	#else
31	fseek_(integer Unit, integer offset, integer *whence)	32	FSEEK_(integer Unit, f77_offset offset, integer *whence)
32	#endif	33	#endif
33	{	34	{
34	FILE *f;	35	FILE *f;
Lines 41-46 Link Here
41	#ifdef SEEK_SET	42	#ifdef SEEK_SET
42	w = wohin[w];	43	w = wohin[w];
43	#endif	44	#endif
44	return !(f = unit_chk(*Unit, "fseek"))	45	return !(f = unit_chk(*Unit, "FSEEK"))
45	\|\| fseek(f, *offset, w) ? 1 : 0;	46	\|\| FSEEK(f, *offset, w) ? 1 : 0;
46	}	47	}

Lines 1-7 Link Here

(-)sue.c (-8 / +8 lines)
1	#include "f2c.h"	1	#include "f2c.h"
2	#include "fio.h"	2	#include "fio.h"
3	extern uiolen f__reclen;	3	extern uiolen f__reclen;
4	long f__recloc;	4	f77_offset f__recloc;
5		5
6	#ifdef KR_headers	6	#ifdef KR_headers
7	c_sue(a) cilist *a;	7	c_sue(a) cilist *a;
Lines 59-83 Link Here
59	f__reclen=0;	59	f__reclen=0;
60	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))	60	if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
61	err(a->cierr, errno, "write start");	61	err(a->cierr, errno, "write start");
62	f__recloc=ftell(f__cf);	62	f__recloc=FTELL(f__cf);
63	(void) fseek(f__cf,(long)sizeof(uiolen),SEEK_CUR);	63	(void) FSEEK(f__cf,(long)sizeof(uiolen),SEEK_CUR);
64	return(0);	64	return(0);
65	}	65	}
66	integer e_wsue(Void)	66	integer e_wsue(Void)
67	{ long loc;	67	{ f77_offset loc;
68	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);	68	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
69	#ifdef ALWAYS_FLUSH	69	#ifdef ALWAYS_FLUSH
70	if (fflush(f__cf))	70	if (fflush(f__cf))
71	err(f__elist->cierr, errno, "write end");	71	err(f__elist->cierr, errno, "write end");
72	#endif	72	#endif
73	loc=ftell(f__cf);	73	loc=FTELL(f__cf);
74	fseek(f__cf,f__recloc,SEEK_SET);	74	FSEEK(f__cf,f__recloc,SEEK_SET);
75	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);	75	fwrite((char *)&f__reclen,sizeof(uiolen),1,f__cf);
76	fseek(f__cf,loc,SEEK_SET);	76	FSEEK(f__cf,loc,SEEK_SET);
77	return(0);	77	return(0);
78	}	78	}
79	integer e_rsue(Void)	79	integer e_rsue(Void)
80	{	80	{
81	(void) fseek(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR);	81	(void) FSEEK(f__cf,(long)(f__reclen-f__recpos+sizeof(uiolen)),SEEK_CUR);
82	return(0);	82	return(0);
83	}	83	}