|
|
1.1 ! root 1: /* ! 2: char id_iio[] = "@(#)iio.c 1.3"; ! 3: * ! 4: * internal (character array) i/o ! 5: */ ! 6: ! 7: #include "fio.h" ! 8: #include "lio.h" ! 9: ! 10: extern int rd_ed(),rd_ned(),w_ed(),w_ned(); ! 11: extern int l_read(),l_write(); ! 12: int z_wnew(),z_rnew(),z_tab(); ! 13: ! 14: z_getc() ! 15: { ! 16: if(icptr >= icend && !recpos) /* new rec beyond eof */ ! 17: { leof = EOF; ! 18: return(EOF); ! 19: } ! 20: if(recpos++ < svic->icirlen) return(*icptr++); ! 21: return(' '); ! 22: } ! 23: ! 24: z_putc(c) char c; ! 25: { ! 26: if(icptr < icend) ! 27: { if(c=='\n') return(z_wnew()); ! 28: if(recpos++ < svic->icirlen) ! 29: { *icptr++ = c; ! 30: return(OK); ! 31: } ! 32: else err(errflag,F_EREREC,"iio") ! 33: } ! 34: leof = EOF; ! 35: #ifndef KOSHER ! 36: err(endflag,EOF,"iio") /* NOT STANDARD, end-of-file on writes */ ! 37: #endif ! 38: #ifdef KOSHER ! 39: err(errflag,F_EREREC,"iio") ! 40: #endif ! 41: } ! 42: ! 43: z_ungetc(ch,cf) char ch; ! 44: { if(ch==EOF || --recpos >= svic->icirlen) return(OK); ! 45: if(--icptr < svic->iciunit || recpos < 0) err(errflag,F_ERBREC,"ilio") ! 46: *icptr = ch; ! 47: return(OK); ! 48: } ! 49: ! 50: s_rsfi(a) icilist *a; ! 51: { ! 52: reading = YES; ! 53: doed=rd_ed; ! 54: doned=rd_ned; ! 55: getn=z_getc; ! 56: doend = donewrec = z_rnew; ! 57: dorevert = z_rnew; ! 58: dotab = z_tab; ! 59: return(c_si(a)); ! 60: } ! 61: ! 62: s_wsfi(a) icilist *a; ! 63: { ! 64: reading = NO; ! 65: doed=w_ed; ! 66: doned=w_ned; ! 67: putn=z_putc; ! 68: doend = donewrec = z_wnew; ! 69: dorevert = z_wnew; ! 70: dotab = z_tab; ! 71: return(c_si(a)); ! 72: } ! 73: ! 74: s_rdfi(a) icilist *a; ! 75: { ! 76: reading = YES; ! 77: doed = rd_ed; ! 78: doned = rd_ned; ! 79: getn = z_getc; ! 80: donewrec = z_rnew; ! 81: dorevert = doend = z_rnew; ! 82: dotab = z_tab; ! 83: return(c_di(a)); ! 84: } ! 85: ! 86: s_wdfi(a) icilist *a; ! 87: { ! 88: reading = NO; ! 89: doed = w_ed; ! 90: doned = w_ned; ! 91: putn = z_putc; ! 92: donewrec = z_wnew; ! 93: dorevert = doend = z_wnew; ! 94: dotab = z_tab; ! 95: return(c_di(a)); ! 96: } ! 97: ! 98: c_fi(a) icilist *a; ! 99: { ! 100: fmtbuf=a->icifmt; ! 101: formatted = FORMATTED; ! 102: external = NO; ! 103: cblank=cplus=NO; ! 104: scale=cursor=0; ! 105: radix = 10; ! 106: signit = YES; ! 107: elist = YES; ! 108: svic = a; ! 109: recpos=reclen=0; ! 110: icend = a->iciunit + a->icirnum*a->icirlen; ! 111: errflag = a->icierr; ! 112: endflag = a->iciend; ! 113: if(pars_f(fmtbuf)) err(errflag,F_ERFMT,"ifio") ! 114: fmt_bg(); ! 115: return(OK); ! 116: } ! 117: ! 118: c_si(a) icilist *a; ! 119: { ! 120: sequential = YES; ! 121: recnum = 0; ! 122: icptr = a->iciunit; ! 123: return(c_fi(a)); ! 124: } ! 125: ! 126: c_di(a) icilist *a; ! 127: { ! 128: sequential = NO; ! 129: recnum = a->icirec - 1; ! 130: icptr = a->iciunit + recnum*a->icirlen; ! 131: return(c_fi(a)); ! 132: } ! 133: ! 134: z_rnew() ! 135: { ! 136: icptr = svic->iciunit + (++recnum)*svic->icirlen; ! 137: recpos = reclen = cursor = 0; ! 138: return(OK); ! 139: } ! 140: ! 141: z_wnew() ! 142: { ! 143: if(reclen > recpos) ! 144: { icptr += (reclen - recpos); ! 145: recpos = reclen; ! 146: } ! 147: while(recpos < svic->icirlen) (*putn)(' '); ! 148: recpos = reclen = cursor = 0; ! 149: recnum++; ! 150: return(OK); ! 151: } ! 152: ! 153: z_tab() ! 154: { int n; ! 155: if(reclen < recpos) reclen = recpos; ! 156: if((recpos + cursor) < 0) cursor = -recpos; /* to BOR */ ! 157: n = reclen - recpos; ! 158: if(!reading && (cursor-n) > 0) ! 159: { icptr += n; ! 160: recpos = reclen; ! 161: cursor -= n; ! 162: while(cursor--) if(n=(*putn)(' ')) return(n); ! 163: } ! 164: else ! 165: { icptr += cursor; ! 166: recpos += cursor; ! 167: } ! 168: return(cursor=0); ! 169: } ! 170: ! 171: e_rsfi() ! 172: { int n; ! 173: n = en_fio(); ! 174: fmtbuf = NULL; ! 175: return(n); ! 176: } ! 177: ! 178: e_wsfi() ! 179: { ! 180: return(e_rsfi()); ! 181: } ! 182: ! 183: e_rdfi() ! 184: { ! 185: return(e_rsfi()); ! 186: } ! 187: ! 188: e_wdfi() ! 189: { ! 190: return(e_wsfi()); ! 191: } ! 192: ! 193: c_li(a) icilist *a; ! 194: { ! 195: fmtbuf="int list io"; ! 196: sequential = formatted = LISTDIRECTED; ! 197: external = NO; ! 198: elist = YES; ! 199: svic = a; ! 200: recnum = recpos = 0; ! 201: cplus = cblank = NO; ! 202: icptr = a->iciunit; ! 203: icend = icptr + a->icirlen * a->icirnum; ! 204: errflag = a->icierr; ! 205: endflag = a->iciend; ! 206: leof = NO; ! 207: return(OK); ! 208: } ! 209: ! 210: s_rsli(a) icilist *a; ! 211: { ! 212: reading = YES; ! 213: lioproc = l_read; ! 214: getn = z_getc; ! 215: ungetn = z_ungetc; ! 216: l_first = YES; ! 217: lcount = 0; ! 218: lquit = NO; ! 219: return(c_li(a)); ! 220: } ! 221: ! 222: s_wsli(a) icilist *a; ! 223: { ! 224: reading = NO; ! 225: putn = z_putc; ! 226: lioproc = l_write; ! 227: line_len = a->icirlen; ! 228: return(c_li(a)); ! 229: } ! 230: ! 231: e_rsli() ! 232: { fmtbuf = NULL; ! 233: return(OK); ! 234: } ! 235: ! 236: e_wsli() ! 237: { fmtbuf = NULL; ! 238: reclen = recpos; ! 239: return(z_wnew()); ! 240: } ! 241: ! 242: ftnint ! 243: iiorec_() ! 244: { return(recnum); } ! 245: ! 246: ftnint ! 247: iiopos_() ! 248: { return(recpos); }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.