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