![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lread.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / lib / libI77uc|
Return to lread.c CVS log | Up to [CSRG BSD Unix] / 40BSD / lib / libI77uc |
1.1 ! root 1: /* ! 2: * list directed read ! 3: */ ! 4: ! 5: #include "fio.h" ! 6: #include "lio.h" ! 7: ! 8: #define SP 1 ! 9: #define B 2 ! 10: #define AP 4 ! 11: #define EX 8 ! 12: #define D 16 ! 13: #define EIN 32 ! 14: #define isblnk(x) (ltab[x+1]&B) ! 15: #define issep(x) (ltab[x+1]&SP) ! 16: #define isapos(x) (ltab[x+1]&AP) ! 17: #define isexp(x) (ltab[x+1]&EX) ! 18: #define isdigit(x) (ltab[x+1]&D) ! 19: #define endlinp(x) (ltab[x+1]&EIN) ! 20: ! 21: #define GETC(x) (x=(*getn)()) ! 22: ! 23: char *lrd = "list read"; ! 24: char *lchar; ! 25: double lx,ly; ! 26: int ltype; ! 27: int l_read(),t_getc(),ungetc(); ! 28: ! 29: char ltab[128+1] = ! 30: { EIN, /* offset one for EOF */ ! 31: /* 0- 15 */ 0,0,AP,0,0,0,0,0,0,B,SP|B|EIN,0,0,0,0,0, /* ^B,TAB,NEWLINE */ ! 32: /* 16- 31 */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, ! 33: /* 32- 47 */ SP|B,0,AP,0,0,0,0,AP,0,0,0,0,SP,0,0,EIN, /* space,",',comma,/ */ ! 34: /* 48- 63 */ D,D,D,D,D,D,D,D,D,D,0,0,0,0,0,0, /* digits 0-9 */ ! 35: /* 64- 79 */ 0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, /* D,E */ ! 36: /* 80- 95 */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, ! 37: /* 96-111 */ 0,0,0,0,EX,EX,0,0,0,0,0,0,0,0,0,0, /* d,e */ ! 38: /* 112-127 */ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ! 39: }; ! 40: ! 41: s_rsle(a) cilist *a; /* start read sequential list external */ ! 42: { ! 43: int n; ! 44: reading = YES; ! 45: if(n=c_le(a,READ)) return(n); ! 46: l_first = YES; ! 47: lquit = NO; ! 48: lioproc = l_read; ! 49: getn = t_getc; ! 50: ungetn = ungetc; ! 51: leof = curunit->uend; ! 52: lcount = 0; ! 53: if(curunit->uwrt) nowreading(curunit); ! 54: return(OK); ! 55: } ! 56: ! 57: t_getc() ! 58: { int ch; ! 59: if(curunit->uend) return(EOF); ! 60: if((ch=getc(cf))!=EOF) return(ch); ! 61: if(feof(cf)) ! 62: { curunit->uend = YES; ! 63: leof = EOF; ! 64: } ! 65: else clearerr(cf); ! 66: return(EOF); ! 67: } ! 68: ! 69: e_rsle() ! 70: { ! 71: int ch; ! 72: if(curunit->uend) return(OK); ! 73: while(!endlinp(GETC(ch))); ! 74: return(OK); ! 75: } ! 76: ! 77: l_read(number,ptr,len,type) ftnint *number,type; flex *ptr; ftnlen len; ! 78: { int i,n,ch; ! 79: double *yy; ! 80: float *xx; ! 81: for(i=0;i<*number;i++) ! 82: { ! 83: if(leof) err(endflag, EOF, lrd) ! 84: if(l_first) ! 85: { l_first = NO; ! 86: while(isblnk(GETC(ch))); /* skip blanks */ ! 87: (*ungetn)(ch,cf); ! 88: } ! 89: else if(lcount==0) /* repeat count == 0 ? */ ! 90: { ERR(t_sep()); /* look for non-blank, allow 1 comma */ ! 91: if(lquit) return(OK); /* slash found */ ! 92: } ! 93: switch((int)type) ! 94: { ! 95: case TYSHORT: ! 96: case TYLONG: ! 97: case TYREAL: ! 98: case TYDREAL: ! 99: ERR(l_R(1)); ! 100: break; ! 101: case TYCOMPLEX: ! 102: case TYDCOMPLEX: ! 103: ERR(l_C()); ! 104: break; ! 105: case TYLOGICAL: ! 106: ERR(l_L()); ! 107: break; ! 108: case TYCHAR: ! 109: ERR(l_CHAR()); ! 110: break; ! 111: } ! 112: if(lquit) return(OK); ! 113: if(leof) err(endflag,EOF,lrd) ! 114: else if(external && ferror(cf)) err(errflag,errno,lrd) ! 115: if(ltype) switch((int)type) ! 116: { ! 117: case TYSHORT: ! 118: ptr->flshort=lx; ! 119: break; ! 120: case TYLOGICAL: ! 121: case TYLONG: ! 122: ptr->flint=lx; ! 123: break; ! 124: case TYREAL: ! 125: ptr->flreal=lx; ! 126: break; ! 127: case TYDREAL: ! 128: ptr->fldouble=lx; ! 129: break; ! 130: case TYCOMPLEX: ! 131: xx=(float *)ptr; ! 132: *xx++ = ly; ! 133: *xx = lx; ! 134: break; ! 135: case TYDCOMPLEX: ! 136: yy=(double *)ptr; ! 137: *yy++ = ly; ! 138: *yy = lx; ! 139: break; ! 140: case TYCHAR: ! 141: b_char(lchar,(char *)ptr,len); ! 142: break; ! 143: } ! 144: if(lcount>0) lcount--; ! 145: ptr = (char *)ptr + len; ! 146: } ! 147: return(OK); ! 148: } ! 149: ! 150: lr_comm() ! 151: { int ch; ! 152: if(lcount) return(lcount); ! 153: ltype=NULL; ! 154: while(isblnk(GETC(ch))); ! 155: if(ch==',') ! 156: { lcount=1; ! 157: return(lcount); ! 158: } ! 159: (*ungetn)(ch,cf); ! 160: if(ch=='/') ! 161: { lquit = YES; ! 162: return(lquit); ! 163: } ! 164: else ! 165: return(OK); ! 166: } ! 167: ! 168: get_repet() ! 169: { char ch; ! 170: double lc; ! 171: if(isdigit(GETC(ch))) ! 172: { (*ungetn)(ch,cf); ! 173: rd_int(&lc); ! 174: lcount = (int)lc; ! 175: if(GETC(ch)!='*') ! 176: if(leof) return(EOF); ! 177: else return(109); ! 178: } ! 179: else ! 180: { lcount = 1; ! 181: (*ungetn)(ch,cf); ! 182: } ! 183: return(OK); ! 184: } ! 185: ! 186: l_R(flg) int flg; ! 187: { double a,b,c,d; ! 188: int da,db,dc,dd; ! 189: int i,ch,sign=0; ! 190: a=b=c=d=0; ! 191: da=db=dc=dd=0; ! 192: if(flg && lr_comm()) return(OK); ! 193: da=rd_int(&a); /* repeat count ? */ ! 194: if(GETC(ch)=='*') ! 195: { ! 196: if (a <= 0.) return(122); ! 197: lcount=(int)a; ! 198: db=rd_int(&b); /* whole part of number */ ! 199: } ! 200: else ! 201: { (*ungetn)(ch,cf); ! 202: db=da; ! 203: b=a; ! 204: lcount=1; ! 205: } ! 206: if(GETC(ch)=='.' && isdigit(GETC(ch))) ! 207: { (*ungetn)(ch,cf); ! 208: dc=rd_int(&c); /* fractional part of number */ ! 209: } ! 210: else ! 211: { (*ungetn)(ch,cf); ! 212: dc=0; ! 213: c=0.; ! 214: } ! 215: if(isexp(GETC(ch))) ! 216: dd=rd_int(&d); /* exponent */ ! 217: else if (ch == '+' || ch == '-') ! 218: { (*ungetn)(ch,cf); ! 219: dd=rd_int(&d); ! 220: } ! 221: else ! 222: { (*ungetn)(ch,cf); ! 223: dd=0; ! 224: } ! 225: if(db<0 || b<0) ! 226: { sign=1; ! 227: b = -b; ! 228: } ! 229: for(i=0;i<dc;i++) c/=10.; ! 230: b=b+c; ! 231: if (dd > 0) ! 232: { for(i=0;i<d;i++) b *= 10.; ! 233: for(i=0;i< -d;i++) b /= 10.; ! 234: } ! 235: lx=sign?-b:b; ! 236: ltype=TYLONG; ! 237: return(OK); ! 238: } ! 239: ! 240: rd_int(x) double *x; ! 241: { int ch,sign=0,i=0; ! 242: double y=0.0; ! 243: if(GETC(ch)=='-') sign = -1; ! 244: else if(ch=='+') sign=0; ! 245: else (*ungetn)(ch,cf); ! 246: while(isdigit(GETC(ch))) ! 247: { i++; ! 248: y=10*y + ch-'0'; ! 249: } ! 250: (*ungetn)(ch,cf); ! 251: if(sign) y = -y; ! 252: *x = y; ! 253: return(y==0.0?sign:i); /* 0:[+]&&y==0, -1:-&&y==0, >0:#digits&&y!=0 */ ! 254: } ! 255: ! 256: l_C() ! 257: { int ch,n; ! 258: if(lr_comm()) return(OK); ! 259: if(n=get_repet()) return(n); /* get repeat count */ ! 260: if(GETC(ch)!='(') err(errflag,112,"no (") ! 261: while(isblnk(GETC(ch))); ! 262: (*ungetn)(ch,cf); ! 263: l_R(0); /* get real part */ ! 264: ly = lx; ! 265: if(t_sep()) return(EOF); ! 266: l_R(0); /* get imag part */ ! 267: while(isblnk(GETC(ch))); ! 268: if(ch!=')') err(errflag,112,"no )") ! 269: ltype = TYCOMPLEX; ! 270: return(OK); ! 271: } ! 272: ! 273: l_L() ! 274: { ! 275: int ch,n; ! 276: if(lr_comm()) return(OK); ! 277: if(n=get_repet()) return(n); /* get repeat count */ ! 278: if(GETC(ch)=='.') GETC(ch); ! 279: switch(ch) ! 280: { ! 281: case 't': ! 282: case 'T': ! 283: lx=1; ! 284: break; ! 285: case 'f': ! 286: case 'F': ! 287: lx=0; ! 288: break; ! 289: default: ! 290: if(isblnk(ch) || issep(ch)) ! 291: { (*ungetn)(ch,cf); ! 292: lx=0; ! 293: return(OK); ! 294: } ! 295: else if(ch==EOF) return(EOF); ! 296: else err(errflag,112,"logical not T or F"); ! 297: } ! 298: ltype=TYLOGICAL; ! 299: while(!issep(GETC(ch)) && !isblnk(ch) && ch!='\n' && ch!=EOF); ! 300: return(OK); ! 301: } ! 302: ! 303: #define BUFSIZE 128 ! 304: l_CHAR() ! 305: { int ch,size,i,n; ! 306: char quote,*p; ! 307: if(lr_comm()) return(OK); ! 308: if(n=get_repet()) return(n); /* get repeat count */ ! 309: if(isapos(GETC(ch))) quote=ch; ! 310: else if(isblnk(ch) || issep(ch) || ch==EOF || ch=='\n') ! 311: { if(ch==EOF) return(EOF); ! 312: (*ungetn)(ch,cf); ! 313: return(OK); ! 314: } ! 315: else ! 316: { quote = '\0'; /* to allow single word non-quoted */ ! 317: (*ungetn)(ch,cf); ! 318: } ! 319: ltype=TYCHAR; ! 320: if(lchar!=NULL) free(lchar); ! 321: size=BUFSIZE-1; ! 322: p=lchar=(char *)malloc(BUFSIZE); ! 323: if(lchar==NULL) err(errflag,113,lrd) ! 324: for(i=0;;) ! 325: { while( ( (quote && GETC(ch)!=quote) || ! 326: (!quote && !issep(GETC(ch)) && !isblnk(ch) ) ) ! 327: && ch!='\n' && ch!=EOF && ++i<size ) ! 328: *p++ = ch; ! 329: if(i==size) ! 330: { ! 331: newone: ! 332: size += BUFSIZE; ! 333: lchar=(char *)realloc(lchar, size+1); ! 334: if(lchar==NULL) err(errflag,113,lrd) ! 335: p=lchar+i-1; ! 336: *p++ = ch; ! 337: } ! 338: else if(ch==EOF) return(EOF); ! 339: else if(ch=='\n') ! 340: { if(*(p-1) == '\\') *(p-1) = ch; ! 341: else if(!quote) ! 342: { *p = '\0'; ! 343: (*ungetn)(ch,cf); ! 344: return(OK); ! 345: } ! 346: } ! 347: else if(quote && GETC(ch)==quote) ! 348: { if(++i<size) *p++ = ch; ! 349: else goto newone; ! 350: } ! 351: else ! 352: { (*ungetn)(ch,cf); ! 353: *p = '\0'; ! 354: return(OK); ! 355: } ! 356: } ! 357: } ! 358: ! 359: t_sep() ! 360: { ! 361: int ch; ! 362: while(isblnk(GETC(ch))); ! 363: if(leof) return(EOF); ! 364: if(ch=='/') ! 365: { lquit = YES; ! 366: (*ungetn)(ch,cf); ! 367: return(OK); ! 368: } ! 369: if(issep(ch)) while(isblnk(GETC(ch))); ! 370: if(leof) return(EOF); ! 371: (*ungetn)(ch,cf); ! 372: return(OK); ! 373: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.