home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / F2C_SRC.ZIP / F2C / LIBI77 / DFE.C < prev    next >
Encoding:
C/C++ Source or Header  |  1991-06-10  |  2.5 KB  |  137 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. extern int rd_ed(),rd_ned(),y_getc(),y_putc(),y_err();
  5. extern int y_rev(), y_rsk(), y_newrec();
  6. extern int w_ed(),w_ned();
  7. integer s_rdfe(a) cilist *a;
  8. {
  9.     int n;
  10.     if(!init) f_init();
  11.     if(n=c_dfe(a))return(n);
  12.     reading=1;
  13.     if(curunit->uwrt && nowreading(curunit))
  14.         err(a->cierr,errno,"read start");
  15.     getn = y_getc;
  16.     doed = rd_ed;
  17.     doned = rd_ned;
  18.     dorevert = donewrec = y_err;
  19.     doend = y_rsk;
  20.     if(pars_f(fmtbuf)<0)
  21.         err(a->cierr,100,"read start");
  22.     fmt_bg();
  23.     return(0);
  24. }
  25. integer s_wdfe(a) cilist *a;
  26. {
  27.     int n;
  28.     if(!init) f_init();
  29.     if(n=c_dfe(a)) return(n);
  30.     reading=0;
  31.     if(curunit->uwrt != 1 && nowwriting(curunit))
  32.         err(a->cierr,errno,"startwrt");
  33.     putn = y_putc;
  34.     doed = w_ed;
  35.     doned= w_ned;
  36.     dorevert = y_err;
  37.     donewrec = y_newrec;
  38.     doend = y_rev;
  39.     if(pars_f(fmtbuf)<0)
  40.         err(a->cierr,100,"startwrt");
  41.     fmt_bg();
  42.     return(0);
  43. }
  44. integer e_rdfe()
  45. {
  46.     (void) en_fio();
  47.     return(0);
  48. }
  49. integer e_wdfe()
  50. {
  51.     (void) en_fio();
  52.     return(0);
  53. }
  54. c_dfe(a) cilist *a;
  55. {
  56.     sequential=0;
  57.     formatted=external=1;
  58.     elist=a;
  59.     cursor=scale=recpos=0;
  60.     if(a->ciunit>MXUNIT || a->ciunit<0)
  61.         err(a->cierr,101,"startchk");
  62.     curunit = &units[a->ciunit];
  63.     if(curunit->ufd==NULL && fk_open(DIR,FMT,a->ciunit))
  64.         err(a->cierr,104,"dfe");
  65.     cf=curunit->ufd;
  66.     if(!curunit->ufmt) err(a->cierr,102,"dfe")
  67.     if(!curunit->useek) err(a->cierr,104,"dfe")
  68.     fmtbuf=a->cifmt;
  69.     (void) fseek(cf,(long)curunit->url * (a->cirec-1),SEEK_SET);
  70.     curunit->uend = 0;
  71.     return(0);
  72. }
  73. y_rsk()
  74. {
  75.     if(curunit->uend || curunit->url <= recpos
  76.         || curunit->url == 1) return 0;
  77.     do {
  78.         getc(cf);
  79.     } while(++recpos < curunit->url);
  80.     return 0;
  81. }
  82. y_getc()
  83. {
  84.     int ch;
  85.     if(curunit->uend) return(-1);
  86.     if((ch=getc(cf))!=EOF)
  87.     {
  88.         recpos++;
  89.         if(curunit->url>=recpos ||
  90.             curunit->url==1)
  91.             return(ch);
  92.         else    return(' ');
  93.     }
  94.     if(feof(cf))
  95.     {
  96.         curunit->uend=1;
  97.         errno=0;
  98.         return(-1);
  99.     }
  100.     err(elist->cierr,errno,"readingd");
  101. }
  102. y_putc(c)
  103. {
  104.     recpos++;
  105.     if(recpos <= curunit->url || curunit->url==1)
  106.         putc(c,cf);
  107.     else
  108.         err(elist->cierr,110,"dout");
  109.     return(0);
  110. }
  111. y_rev()
  112. {    /*what about work done?*/
  113.     if(curunit->url==1 || recpos==curunit->url)
  114.         return(0);
  115.     while(recpos<curunit->url)
  116.         (*putn)(' ');
  117.     recpos=0;
  118.     return(0);
  119. }
  120. y_err()
  121. {
  122.     err(elist->cierr, 110, "dfe");
  123. }
  124.  
  125. y_newrec()
  126. {
  127.     if(curunit->url == 1 || recpos == curunit->url) {
  128.         hiwater = recpos = cursor = 0;
  129.         return(1);
  130.     }
  131.     if(hiwater > recpos)
  132.         recpos = hiwater;
  133.     y_rev();
  134.     hiwater = cursor = 0;
  135.     return(1);
  136. }
  137.