source: trunk/third/gcc/libf2c/libI77/due.c @ 14548

Revision 14548, 1.6 KB checked in by ghudson, 24 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14547, which included commits to RCS files with non-trunk default branches.
Line 
1#include "f2c.h"
2#include "fio.h"
3
4#ifdef KR_headers
5c_due(a) cilist *a;
6#else
7c_due(cilist *a)
8#endif
9{
10        if(f__init != 1) f_init();
11        f__init = 3;
12        if(a->ciunit>=MXUNIT || a->ciunit<0)
13                err(a->cierr,101,"startio");
14        f__sequential=f__formatted=f__recpos=0;
15        f__external=1;
16        f__curunit = &f__units[a->ciunit];
17        if(a->ciunit>=MXUNIT || a->ciunit<0)
18                err(a->cierr,101,"startio");
19        f__elist=a;
20        if(f__curunit->ufd==NULL && fk_open(DIR,UNF,a->ciunit) ) err(a->cierr,104,"due");
21        f__cf=f__curunit->ufd;
22        if(f__curunit->ufmt) err(a->cierr,102,"cdue");
23        if(!f__curunit->useek) err(a->cierr,104,"cdue");
24        if(f__curunit->ufd==NULL) err(a->cierr,114,"cdue");
25        if(a->cirec <= 0)
26                err(a->cierr,130,"due");
27        fseek(f__cf,(long)(a->cirec-1)*f__curunit->url,SEEK_SET);
28        f__curunit->uend = 0;
29        return(0);
30}
31#ifdef KR_headers
32integer s_rdue(a) cilist *a;
33#else
34integer s_rdue(cilist *a)
35#endif
36{
37        int n;
38        f__reading=1;
39        if(n=c_due(a)) return(n);
40        if(f__curunit->uwrt && f__nowreading(f__curunit))
41                err(a->cierr,errno,"read start");
42        return(0);
43}
44#ifdef KR_headers
45integer s_wdue(a) cilist *a;
46#else
47integer s_wdue(cilist *a)
48#endif
49{
50        int n;
51        f__reading=0;
52        if(n=c_due(a)) return(n);
53        if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
54                err(a->cierr,errno,"write start");
55        return(0);
56}
57integer e_rdue(Void)
58{
59        f__init = 1;
60        if(f__curunit->url==1 || f__recpos==f__curunit->url)
61                return(0);
62        fseek(f__cf,(long)(f__curunit->url-f__recpos),SEEK_CUR);
63        if(ftell(f__cf)%f__curunit->url)
64                err(f__elist->cierr,200,"syserr");
65        return(0);
66}
67integer e_wdue(Void)
68{
69        f__init = 1;
70#ifdef ALWAYS_FLUSH
71        if (fflush(f__cf))
72                err(f__elist->cierr,errno,"write end");
73#endif
74        return(e_rdue());
75}
Note: See TracBrowser for help on using the repository browser.