Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
rdfmt.c
Go to the documentation of this file.00001 #include "stdlib.h"
00002 #include "f2c.h"
00003 #include "fio.h"
00004 #include "fmt.h"
00005 #include "fp.h"
00006 #include "ctype.h"
00007
00008 extern int f__cursor;
00009 #ifdef KR_headers
00010 extern double atof();
00011 #else
00012 #undef abs
00013 #undef min
00014 #undef max
00015 #include "stdlib.h"
00016 #endif
00017
00018 static int
00019 #ifdef KR_headers
00020 rd_Z(n,w,len) Uint *n; ftnlen len;
00021 #else
00022 rd_Z(Uint *n, int w, ftnlen len)
00023 #endif
00024 {
00025 long x[9];
00026 char *s, *s0, *s1, *se, *t;
00027 int ch, i, w1, w2;
00028 static char hex[256];
00029 static int one = 1;
00030 int bad = 0;
00031
00032 if (!hex['0']) {
00033 s = "0123456789";
00034 while(ch = *s++)
00035 hex[ch] = ch - '0' + 1;
00036 s = "ABCDEF";
00037 while(ch = *s++)
00038 hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11;
00039 }
00040 s = s0 = (char *)x;
00041 s1 = (char *)&x[4];
00042 se = (char *)&x[8];
00043 if (len > 4*sizeof(long))
00044 return errno = 117;
00045 while (w) {
00046 GET(ch);
00047 if (ch==',' || ch=='\n')
00048 break;
00049 w--;
00050 if (ch > ' ') {
00051 if (!hex[ch & 0xff])
00052 bad++;
00053 *s++ = ch;
00054 if (s == se) {
00055
00056 for(t = s0, s = s1; t < s1;)
00057 *t++ = *s++;
00058 s = s1;
00059 }
00060 }
00061 }
00062 if (bad)
00063 return errno = 115;
00064 w = (int)len;
00065 w1 = s - s0;
00066 w2 = w1+1 >> 1;
00067 t = (char *)n;
00068 if (*(char *)&one) {
00069
00070 t += w - 1;
00071 i = -1;
00072 }
00073 else
00074 i = 1;
00075 for(; w > w2; t += i, --w)
00076 *t = 0;
00077 if (!w)
00078 return 0;
00079 if (w < w2)
00080 s0 = s - (w << 1);
00081 else if (w1 & 1) {
00082 *t = hex[*s0++ & 0xff] - 1;
00083 if (!--w)
00084 return 0;
00085 t += i;
00086 }
00087 do {
00088 *t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1;
00089 t += i;
00090 s0 += 2;
00091 }
00092 while(--w);
00093 return 0;
00094 }
00095
00096 static int
00097 #ifdef KR_headers
00098 rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base;
00099 #else
00100 rd_I(Uint *n, int w, ftnlen len, register int base)
00101 #endif
00102 { longint x;
00103 int sign,ch;
00104 char s[84], *ps;
00105 ps=s; x=0;
00106 while (w)
00107 {
00108 GET(ch);
00109 if (ch==',' || ch=='\n') break;
00110 *ps=ch; ps++; w--;
00111 }
00112 *ps='\0';
00113 ps=s;
00114 while (*ps==' ') ps++;
00115 if (*ps=='-') { sign=1; ps++; }
00116 else { sign=0; if (*ps=='+') ps++; }
00117 loop: while (*ps>='0' && *ps<='9') { x=x*base+(*ps-'0'); ps++; }
00118 if (*ps==' ') {if (f__cblank) x *= base; ps++; goto loop;}
00119 if(sign) x = -x;
00120 if(len==sizeof(integer)) n->il=x;
00121 else if(len == sizeof(char)) n->ic = (char)x;
00122 #ifdef Allow_TYQUAD
00123 else if (len == sizeof(longint)) n->ili = x;
00124 #endif
00125 else n->is = (short)x;
00126 if (*ps) return(errno=115); else return(0);
00127 }
00128 static int
00129 #ifdef KR_headers
00130 rd_L(n,w,len) ftnint *n; ftnlen len;
00131 #else
00132 rd_L(ftnint *n, int w, ftnlen len)
00133 #endif
00134 { int ch, lv;
00135 char s[84], *ps;
00136 ps=s;
00137 while (w) {
00138 GET(ch);
00139 if (ch==','||ch=='\n') break;
00140 *ps=ch;
00141 ps++; w--;
00142 }
00143 *ps='\0';
00144 ps=s; while (*ps==' ') ps++;
00145 if (*ps=='.') ps++;
00146 if (*ps=='t' || *ps == 'T')
00147 lv = 1;
00148 else if (*ps == 'f' || *ps == 'F')
00149 lv = 0;
00150 else return(errno=116);
00151 switch(len) {
00152 case sizeof(char): *(char *)n = (char)lv; break;
00153 case sizeof(short): *(short *)n = (short)lv; break;
00154 default: *n = lv;
00155 }
00156 return 0;
00157 }
00158
00159 static int
00160 #ifdef KR_headers
00161 rd_F(p, w, d, len) ufloat *p; ftnlen len;
00162 #else
00163 rd_F(ufloat *p, int w, int d, ftnlen len)
00164 #endif
00165 {
00166 char s[FMAX+EXPMAXDIGS+4];
00167 register int ch;
00168 register char *sp, *spe, *sp1;
00169 double x;
00170 int scale1, se;
00171 long e, exp;
00172
00173 sp1 = sp = s;
00174 spe = sp + FMAX;
00175 exp = -d;
00176 x = 0.;
00177
00178 do {
00179 GET(ch);
00180 w--;
00181 } while (ch == ' ' && w);
00182 switch(ch) {
00183 case '-': *sp++ = ch; sp1++; spe++;
00184 case '+':
00185 if (!w) goto zero;
00186 --w;
00187 GET(ch);
00188 }
00189 while(ch == ' ') {
00190 blankdrop:
00191 if (!w--) goto zero; GET(ch); }
00192 while(ch == '0')
00193 { if (!w--) goto zero; GET(ch); }
00194 if (ch == ' ' && f__cblank)
00195 goto blankdrop;
00196 scale1 = f__scale;
00197 while(isdigit(ch)) {
00198 digloop1:
00199 if (sp < spe) *sp++ = ch;
00200 else ++exp;
00201 digloop1e:
00202 if (!w--) goto done;
00203 GET(ch);
00204 }
00205 if (ch == ' ') {
00206 if (f__cblank)
00207 { ch = '0'; goto digloop1; }
00208 goto digloop1e;
00209 }
00210 if (ch == '.') {
00211 exp += d;
00212 if (!w--) goto done;
00213 GET(ch);
00214 if (sp == sp1) {
00215 while(ch == '0') {
00216 skip01:
00217 --exp;
00218 skip0:
00219 if (!w--) goto done;
00220 GET(ch);
00221 }
00222 if (ch == ' ') {
00223 if (f__cblank) goto skip01;
00224 goto skip0;
00225 }
00226 }
00227 while(isdigit(ch)) {
00228 digloop2:
00229 if (sp < spe)
00230 { *sp++ = ch; --exp; }
00231 digloop2e:
00232 if (!w--) goto done;
00233 GET(ch);
00234 }
00235 if (ch == ' ') {
00236 if (f__cblank)
00237 { ch = '0'; goto digloop2; }
00238 goto digloop2e;
00239 }
00240 }
00241 switch(ch) {
00242 default:
00243 break;
00244 case '-': se = 1; goto signonly;
00245 case '+': se = 0; goto signonly;
00246 case 'e':
00247 case 'E':
00248 case 'd':
00249 case 'D':
00250 if (!w--)
00251 goto bad;
00252 GET(ch);
00253 while(ch == ' ') {
00254 if (!w--)
00255 goto bad;
00256 GET(ch);
00257 }
00258 se = 0;
00259 switch(ch) {
00260 case '-': se = 1;
00261 case '+':
00262 signonly:
00263 if (!w--)
00264 goto bad;
00265 GET(ch);
00266 }
00267 while(ch == ' ') {
00268 if (!w--)
00269 goto bad;
00270 GET(ch);
00271 }
00272 if (!isdigit(ch))
00273 goto bad;
00274
00275 e = ch - '0';
00276 for(;;) {
00277 if (!w--)
00278 { ch = '\n'; break; }
00279 GET(ch);
00280 if (!isdigit(ch)) {
00281 if (ch == ' ') {
00282 if (f__cblank)
00283 ch = '0';
00284 else continue;
00285 }
00286 else
00287 break;
00288 }
00289 e = 10*e + ch - '0';
00290 if (e > EXPMAX && sp > sp1)
00291 goto bad;
00292 }
00293 if (se)
00294 exp -= e;
00295 else
00296 exp += e;
00297 scale1 = 0;
00298 }
00299 switch(ch) {
00300 case '\n':
00301 case ',':
00302 break;
00303 default:
00304 bad:
00305 return (errno = 115);
00306 }
00307 done:
00308 if (sp > sp1) {
00309 while(*--sp == '0')
00310 ++exp;
00311 if (exp -= scale1)
00312 sprintf(sp+1, "e%ld", exp);
00313 else
00314 sp[1] = 0;
00315 x = atof(s);
00316 }
00317 zero:
00318 if (len == sizeof(real))
00319 p->pf = x;
00320 else
00321 p->pd = x;
00322 return(0);
00323 }
00324
00325
00326 static int
00327 #ifdef KR_headers
00328 rd_A(p,len) char *p; ftnlen len;
00329 #else
00330 rd_A(char *p, ftnlen len)
00331 #endif
00332 { int i,ch;
00333 for(i=0;i<len;i++)
00334 { GET(ch);
00335 *p++=VAL(ch);
00336 }
00337 return(0);
00338 }
00339 static int
00340 #ifdef KR_headers
00341 rd_AW(p,w,len) char *p; ftnlen len;
00342 #else
00343 rd_AW(char *p, int w, ftnlen len)
00344 #endif
00345 { int i,ch;
00346 if(w>=len)
00347 { for(i=0;i<w-len;i++)
00348 GET(ch);
00349 for(i=0;i<len;i++)
00350 { GET(ch);
00351 *p++=VAL(ch);
00352 }
00353 return(0);
00354 }
00355 for(i=0;i<w;i++)
00356 { GET(ch);
00357 *p++=VAL(ch);
00358 }
00359 for(i=0;i<len-w;i++) *p++=' ';
00360 return(0);
00361 }
00362 static int
00363 #ifdef KR_headers
00364 rd_H(n,s) char *s;
00365 #else
00366 rd_H(int n, char *s)
00367 #endif
00368 { int i,ch;
00369 for(i=0;i<n;i++)
00370 if((ch=(*f__getn)())<0) return(ch);
00371 else *s++ = ch=='\n'?' ':ch;
00372 return(1);
00373 }
00374 static int
00375 #ifdef KR_headers
00376 rd_POS(s) char *s;
00377 #else
00378 rd_POS(char *s)
00379 #endif
00380 { char quote;
00381 int ch;
00382 quote= *s++;
00383 for(;*s;s++)
00384 if(*s==quote && *(s+1)!=quote) break;
00385 else if((ch=(*f__getn)())<0) return(ch);
00386 else *s = ch=='\n'?' ':ch;
00387 return(1);
00388 }
00389 #ifdef KR_headers
00390 rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
00391 #else
00392 rd_ed(struct syl *p, char *ptr, ftnlen len)
00393 #endif
00394 { int ch;
00395 for(;f__cursor>0;f__cursor--) if((ch=(*f__getn)())<0) return(ch);
00396 if(f__cursor<0)
00397 { if(f__recpos+f__cursor < 0)
00398 f__cursor = -f__recpos;
00399 if(f__external == 0) {
00400 extern char *f__icptr;
00401 f__icptr += f__cursor;
00402 }
00403 else if(f__curunit && f__curunit->useek)
00404 (void) fseek(f__cf,(long) f__cursor,SEEK_CUR);
00405 else
00406 err(f__elist->cierr,106,"fmt");
00407 f__recpos += f__cursor;
00408 f__cursor=0;
00409 }
00410 switch(p->op)
00411 {
00412 default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op);
00413 sig_die(f__fmtbuf, 1);
00414 case IM:
00415 case I: ch = rd_I((Uint *)ptr,p->p1,len, 10);
00416 break;
00417
00418
00419
00420
00421
00422 case OM:
00423 case O: ch = rd_I((Uint *)ptr, p->p1, len, 8);
00424 break;
00425 case L: ch = rd_L((ftnint *)ptr,p->p1,len);
00426 break;
00427 case A: ch = rd_A(ptr,len);
00428 break;
00429 case AW:
00430 ch = rd_AW(ptr,p->p1,len);
00431 break;
00432 case E: case EE:
00433 case D:
00434 case G:
00435 case GE:
00436 case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2,len);
00437 break;
00438
00439
00440
00441 case ZM:
00442 case Z:
00443 ch = rd_Z((Uint *)ptr, p->p1, len);
00444 break;
00445 }
00446 if(ch == 0) return(ch);
00447 else if(ch == EOF) return(EOF);
00448 if (f__cf)
00449 clearerr(f__cf);
00450 return(errno);
00451 }
00452 #ifdef KR_headers
00453 rd_ned(p) struct syl *p;
00454 #else
00455 rd_ned(struct syl *p)
00456 #endif
00457 {
00458 switch(p->op)
00459 {
00460 default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op);
00461 sig_die(f__fmtbuf, 1);
00462 case APOS:
00463 return(rd_POS(*(char **)&p->p2));
00464 case H: return(rd_H(p->p1,*(char **)&p->p2));
00465 case SLASH: return((*f__donewrec)());
00466 case TR:
00467 case X: f__cursor += p->p1;
00468 return(1);
00469 case T: f__cursor=p->p1-f__recpos - 1;
00470 return(1);
00471 case TL: f__cursor -= p->p1;
00472 if(f__cursor < -f__recpos)
00473 f__cursor = -f__recpos;
00474 return(1);
00475 }
00476 }