1*20995Slibs /* 2*20995Slibs char id_c_iio[] = "@(#)c_iio.c 1.1"; 3*20995Slibs * 4*20995Slibs * internal (character array) i/o: common portions 5*20995Slibs */ 6*20995Slibs 7*20995Slibs #include "fio.h" 8*20995Slibs #include "lio.h" 9*20995Slibs 10*20995Slibs LOCAL icilist *svic; /* active internal io list */ 11*20995Slibs 12*20995Slibs int z_wnew(); 13*20995Slibs 14*20995Slibs z_getc() 15*20995Slibs { 16*20995Slibs if(icptr >= icend && !recpos) /* new rec beyond eof */ 17*20995Slibs { leof = EOF; 18*20995Slibs return(EOF); 19*20995Slibs } 20*20995Slibs if(recpos++ < svic->icirlen) return(*icptr++); 21*20995Slibs if(formatted == LISTDIRECTED) return(EOF); 22*20995Slibs return(' '); 23*20995Slibs } 24*20995Slibs 25*20995Slibs z_putc(c) char c; 26*20995Slibs { 27*20995Slibs if(icptr < icend) 28*20995Slibs { if(c=='\n') return(z_wnew()); 29*20995Slibs if(recpos++ < svic->icirlen) 30*20995Slibs { *icptr++ = c; 31*20995Slibs return(OK); 32*20995Slibs } 33*20995Slibs else err(errflag,F_EREREC,"iio") 34*20995Slibs } 35*20995Slibs leof = EOF; 36*20995Slibs #ifndef KOSHER 37*20995Slibs err(endflag,EOF,"iio") /* NOT STANDARD, end-of-file on writes */ 38*20995Slibs #endif 39*20995Slibs #ifdef KOSHER 40*20995Slibs err(errflag,F_EREREC,"iio") 41*20995Slibs #endif 42*20995Slibs } 43*20995Slibs 44*20995Slibs z_ungetc(ch,cf) char ch; 45*20995Slibs { if(ch==EOF || --recpos >= svic->icirlen) return(OK); 46*20995Slibs if(--icptr < svic->iciunit || recpos < 0) err(errflag,F_ERBREC,"ilio") 47*20995Slibs *icptr = ch; 48*20995Slibs return(OK); 49*20995Slibs } 50*20995Slibs 51*20995Slibs LOCAL 52*20995Slibs c_fi(a) icilist *a; 53*20995Slibs { 54*20995Slibs fmtbuf=a->icifmt; 55*20995Slibs formatted = FORMATTED; 56*20995Slibs external = NO; 57*20995Slibs cblank=cplus=NO; 58*20995Slibs scale=cursor=0; 59*20995Slibs radix = 10; 60*20995Slibs signit = YES; 61*20995Slibs elist = YES; 62*20995Slibs svic = a; 63*20995Slibs recpos=reclen=0; 64*20995Slibs icend = a->iciunit + a->icirnum*a->icirlen; 65*20995Slibs errflag = a->icierr; 66*20995Slibs endflag = a->iciend; 67*20995Slibs return(OK); 68*20995Slibs } 69*20995Slibs 70*20995Slibs c_si(a) icilist *a; 71*20995Slibs { 72*20995Slibs sequential = YES; 73*20995Slibs recnum = 0; 74*20995Slibs icptr = a->iciunit; 75*20995Slibs return(c_fi(a)); 76*20995Slibs } 77*20995Slibs 78*20995Slibs c_di(a) icilist *a; 79*20995Slibs { 80*20995Slibs sequential = NO; 81*20995Slibs recnum = a->icirec - 1; 82*20995Slibs icptr = a->iciunit + recnum*a->icirlen; 83*20995Slibs return(c_fi(a)); 84*20995Slibs } 85*20995Slibs 86*20995Slibs z_rnew() 87*20995Slibs { 88*20995Slibs icptr = svic->iciunit + (++recnum)*svic->icirlen; 89*20995Slibs recpos = reclen = cursor = 0; 90*20995Slibs return(OK); 91*20995Slibs } 92*20995Slibs 93*20995Slibs z_wnew() 94*20995Slibs { 95*20995Slibs if(reclen > recpos) 96*20995Slibs { icptr += (reclen - recpos); 97*20995Slibs recpos = reclen; 98*20995Slibs } 99*20995Slibs while(recpos < svic->icirlen) (*putn)(' '); 100*20995Slibs recpos = reclen = cursor = 0; 101*20995Slibs recnum++; 102*20995Slibs return(OK); 103*20995Slibs } 104*20995Slibs 105*20995Slibs z_tab() 106*20995Slibs { int n; 107*20995Slibs if(reclen < recpos) reclen = recpos; 108*20995Slibs if((recpos + cursor) < 0) cursor = -recpos; /* to BOR */ 109*20995Slibs n = reclen - recpos; 110*20995Slibs if(!reading && (cursor-n) > 0) 111*20995Slibs { icptr += n; 112*20995Slibs recpos = reclen; 113*20995Slibs cursor -= n; 114*20995Slibs while(cursor--) if(n=(*putn)(' ')) return(n); 115*20995Slibs } 116*20995Slibs else 117*20995Slibs { icptr += cursor; 118*20995Slibs recpos += cursor; 119*20995Slibs } 120*20995Slibs return(cursor=0); 121*20995Slibs } 122*20995Slibs 123*20995Slibs c_li(a) icilist *a; 124*20995Slibs { 125*20995Slibs fmtbuf="int list io"; 126*20995Slibs sequential = formatted = LISTDIRECTED; 127*20995Slibs external = NO; 128*20995Slibs elist = YES; 129*20995Slibs svic = a; 130*20995Slibs recnum = recpos = 0; 131*20995Slibs cplus = cblank = NO; 132*20995Slibs icptr = a->iciunit; 133*20995Slibs icend = icptr + a->icirlen * a->icirnum; 134*20995Slibs errflag = a->icierr; 135*20995Slibs endflag = a->iciend; 136*20995Slibs leof = NO; 137*20995Slibs return(OK); 138*20995Slibs } 139*20995Slibs 140*20995Slibs ftnint 141*20995Slibs iiorec_() 142*20995Slibs { return(recnum); } 143*20995Slibs 144*20995Slibs ftnint 145*20995Slibs iiopos_() 146*20995Slibs { return(recpos); } 147