#include "f2c.h"#include "fio.h"#include "stdlib.h"#include "fmt.h"#include "fp.h"#include "ctype.h"Include dependency graph for rdfmt.c:
Go to the source code of this file.
Functions | |
| static int | rd_Z (Uint *n, int w, ftnlen len) |
| static int | rd_I (Uint *n, int w, ftnlen len, register int base) |
| static int | rd_L (ftnint *n, int w, ftnlen len) |
| static int | rd_F (ufloat *p, int w, int d, ftnlen len) |
| static int | rd_A (char *p, ftnlen len) |
| static int | rd_AW (char *p, int w, ftnlen len) |
| static int | rd_H (int n, char *s) |
| static int | rd_POS (char *s) |
| int | rd_ed (struct syl *p, char *ptr, ftnlen len) |
| int | rd_ned (struct syl *p) |
Definition at line 410 of file rdfmt.c.
Referenced by rd_ed().
00412 { int i,ch; 00413 if(w>=len) 00414 { for(i=0;i<w-len;i++) 00415 GET(ch); 00416 for(i=0;i<len;i++) 00417 { GET(ch); 00418 *p++=VAL(ch); 00419 } 00420 return(0); 00421 } 00422 for(i=0;i<w;i++) 00423 { GET(ch); 00424 *p++=VAL(ch); 00425 } 00426 for(i=0;i<len-w;i++) *p++=' '; 00427 return(0); 00428 }
Here is the caller graph for this function:
Definition at line 461 of file rdfmt.c.
References A, AW, cilist::cierr, D, E, EE, err, errno, F, f__cf, f__cursor, f__curunit, f__elist, f__external, f__fmtbuf, f__getn, f__icptr, f__recpos, FSEEK, G, GE, I, IM, L, O, OM, p, rd_A(), rd_AW(), rd_F(), rd_I(), rd_L(), rd_Z(), SEEK_CUR, sig_die(), unit::useek, Z, and ZM.
00463 { int ch; 00464 for(;f__cursor>0;f__cursor--) if((ch=(*f__getn)())<0) return(ch); 00465 if(f__cursor<0) 00466 { if(f__recpos+f__cursor < 0) /*err(elist->cierr,110,"fmt")*/ 00467 f__cursor = -f__recpos; /* is this in the standard? */ 00468 if(f__external == 0) { 00469 extern char *f__icptr; 00470 f__icptr += f__cursor; 00471 } 00472 else if(f__curunit && f__curunit->useek) 00473 (void) FSEEK(f__cf, f__cursor,SEEK_CUR); 00474 else 00475 err(f__elist->cierr,106,"fmt"); 00476 f__recpos += f__cursor; 00477 f__cursor=0; 00478 } 00479 switch(p->op) 00480 { 00481 default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op); 00482 sig_die(f__fmtbuf, 1); 00483 case IM: 00484 case I: ch = rd_I((Uint *)ptr,p->p1,len, 10); 00485 break; 00486 00487 /* O and OM don't work right for character, double, complex, */ 00488 /* or doublecomplex, and they differ from Fortran 90 in */ 00489 /* showing a minus sign for negative values. */ 00490 00491 case OM: 00492 case O: ch = rd_I((Uint *)ptr, p->p1, len, 8); 00493 break; 00494 case L: ch = rd_L((ftnint *)ptr,p->p1,len); 00495 break; 00496 case A: ch = rd_A(ptr,len); 00497 break; 00498 case AW: 00499 ch = rd_AW(ptr,p->p1,len); 00500 break; 00501 case E: case EE: 00502 case D: 00503 case G: 00504 case GE: 00505 case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2.i[0],len); 00506 break; 00507 00508 /* Z and ZM assume 8-bit bytes. */ 00509 00510 case ZM: 00511 case Z: 00512 ch = rd_Z((Uint *)ptr, p->p1, len); 00513 break; 00514 } 00515 if(ch == 0) return(ch); 00516 else if(ch == EOF) return(EOF); 00517 if (f__cf) 00518 clearerr(f__cf); 00519 return(errno); 00520 }
Here is the call graph for this function:
Definition at line 230 of file rdfmt.c.
References done, errno, EXPMAX, EXPMAXDIGS, f__cblank, f__scale, FMAX, GET, p, s, sp(), and x.
Referenced by rd_ed().
00232 { 00233 char s[FMAX+EXPMAXDIGS+4]; 00234 register int ch; 00235 register char *sp, *spe, *sp1; 00236 double x; 00237 int scale1, se; 00238 long e, exp; 00239 00240 sp1 = sp = s; 00241 spe = sp + FMAX; 00242 exp = -d; 00243 x = 0.; 00244 00245 do { 00246 GET(ch); 00247 w--; 00248 } while (ch == ' ' && w); 00249 switch(ch) { 00250 case '-': *sp++ = ch; sp1++; spe++; 00251 case '+': 00252 if (!w) goto zero; 00253 --w; 00254 GET(ch); 00255 } 00256 while(ch == ' ') { 00257 blankdrop: 00258 if (!w--) goto zero; GET(ch); } 00259 while(ch == '0') 00260 { if (!w--) goto zero; GET(ch); } 00261 if (ch == ' ' && f__cblank) 00262 goto blankdrop; 00263 scale1 = f__scale; 00264 while(isdigit(ch)) { 00265 digloop1: 00266 if (sp < spe) *sp++ = ch; 00267 else ++exp; 00268 digloop1e: 00269 if (!w--) goto done; 00270 GET(ch); 00271 } 00272 if (ch == ' ') { 00273 if (f__cblank) 00274 { ch = '0'; goto digloop1; } 00275 goto digloop1e; 00276 } 00277 if (ch == '.') { 00278 exp += d; 00279 if (!w--) goto done; 00280 GET(ch); 00281 if (sp == sp1) { /* no digits yet */ 00282 while(ch == '0') { 00283 skip01: 00284 --exp; 00285 skip0: 00286 if (!w--) goto done; 00287 GET(ch); 00288 } 00289 if (ch == ' ') { 00290 if (f__cblank) goto skip01; 00291 goto skip0; 00292 } 00293 } 00294 while(isdigit(ch)) { 00295 digloop2: 00296 if (sp < spe) 00297 { *sp++ = ch; --exp; } 00298 digloop2e: 00299 if (!w--) goto done; 00300 GET(ch); 00301 } 00302 if (ch == ' ') { 00303 if (f__cblank) 00304 { ch = '0'; goto digloop2; } 00305 goto digloop2e; 00306 } 00307 } 00308 switch(ch) { 00309 default: 00310 break; 00311 case '-': se = 1; goto signonly; 00312 case '+': se = 0; goto signonly; 00313 case 'e': 00314 case 'E': 00315 case 'd': 00316 case 'D': 00317 if (!w--) 00318 goto bad; 00319 GET(ch); 00320 while(ch == ' ') { 00321 if (!w--) 00322 goto bad; 00323 GET(ch); 00324 } 00325 se = 0; 00326 switch(ch) { 00327 case '-': se = 1; 00328 case '+': 00329 signonly: 00330 if (!w--) 00331 goto bad; 00332 GET(ch); 00333 } 00334 while(ch == ' ') { 00335 if (!w--) 00336 goto bad; 00337 GET(ch); 00338 } 00339 if (!isdigit(ch)) 00340 goto bad; 00341 00342 e = ch - '0'; 00343 for(;;) { 00344 if (!w--) 00345 { ch = '\n'; break; } 00346 GET(ch); 00347 if (!isdigit(ch)) { 00348 if (ch == ' ') { 00349 if (f__cblank) 00350 ch = '0'; 00351 else continue; 00352 } 00353 else 00354 break; 00355 } 00356 e = 10*e + ch - '0'; 00357 if (e > EXPMAX && sp > sp1) 00358 goto bad; 00359 } 00360 if (se) 00361 exp -= e; 00362 else 00363 exp += e; 00364 scale1 = 0; 00365 } 00366 switch(ch) { 00367 case '\n': 00368 case ',': 00369 break; 00370 default: 00371 bad: 00372 return (errno = 115); 00373 } 00374 done: 00375 if (sp > sp1) { 00376 while(*--sp == '0') 00377 ++exp; 00378 if (exp -= scale1) 00379 sprintf(sp+1, "e%ld", exp); 00380 else 00381 sp[1] = 0; 00382 x = atof(s); 00383 } 00384 zero: 00385 if (len == sizeof(real)) 00386 p->pf = (real)x; 00387 else 00388 p->pd = x; 00389 return(0); 00390 }
Here is the call graph for this function:
Here is the caller graph for this function:
Definition at line 102 of file rdfmt.c.
References errno, f__cblank, GET, longint, n, sign, and x.
Referenced by rd_ed().
00104 { 00105 int ch, sign; 00106 longint x = 0; 00107 00108 if (w <= 0) 00109 goto have_x; 00110 for(;;) { 00111 GET(ch); 00112 if (ch != ' ') 00113 break; 00114 if (!--w) 00115 goto have_x; 00116 } 00117 sign = 0; 00118 switch(ch) { 00119 case ',': 00120 case '\n': 00121 w = 0; 00122 goto have_x; 00123 case '-': 00124 sign = 1; 00125 case '+': 00126 break; 00127 default: 00128 if (ch >= '0' && ch <= '9') { 00129 x = ch - '0'; 00130 break; 00131 } 00132 goto have_x; 00133 } 00134 while(--w) { 00135 GET(ch); 00136 if (ch >= '0' && ch <= '9') { 00137 x = x*base + ch - '0'; 00138 continue; 00139 } 00140 if (ch != ' ') { 00141 if (ch == '\n' || ch == ',') 00142 w = 0; 00143 break; 00144 } 00145 if (f__cblank) 00146 x *= base; 00147 } 00148 if (sign) 00149 x = -x; 00150 have_x: 00151 if(len == sizeof(integer)) 00152 n->il=x; 00153 else if(len == sizeof(char)) 00154 n->ic = (char)x; 00155 #ifdef Allow_TYQUAD 00156 else if (len == sizeof(longint)) 00157 n->ili = x; 00158 #endif 00159 else 00160 n->is = (short)x; 00161 if (w) { 00162 while(--w) 00163 GET(ch); 00164 return errno = 115; 00165 } 00166 return 0; 00167 }
Here is the caller graph for this function:
Definition at line 173 of file rdfmt.c.
References dot, errno, and GET.
Referenced by rd_ed().
00175 { int ch, dot, lv; 00176 00177 if (w <= 0) 00178 goto bad; 00179 for(;;) { 00180 GET(ch); 00181 --w; 00182 if (ch != ' ') 00183 break; 00184 if (!w) 00185 goto bad; 00186 } 00187 dot = 0; 00188 retry: 00189 switch(ch) { 00190 case '.': 00191 if (dot++ || !w) 00192 goto bad; 00193 GET(ch); 00194 --w; 00195 goto retry; 00196 case 't': 00197 case 'T': 00198 lv = 1; 00199 break; 00200 case 'f': 00201 case 'F': 00202 lv = 0; 00203 break; 00204 default: 00205 bad: 00206 for(; w > 0; --w) 00207 GET(ch); 00208 /* no break */ 00209 case ',': 00210 case '\n': 00211 return errno = 116; 00212 } 00213 switch(len) { 00214 case sizeof(char): *(char *)n = (char)lv; break; 00215 case sizeof(short): *(short *)n = (short)lv; break; 00216 default: *n = lv; 00217 } 00218 while(w-- > 0) { 00219 GET(ch); 00220 if (ch == ',' || ch == '\n') 00221 break; 00222 } 00223 return 0; 00224 }
Here is the caller graph for this function:
Definition at line 526 of file rdfmt.c.
References APOS, f__cursor, f__donewrec, f__fmtbuf, f__recpos, H, p, rd_H(), rd_POS(), sig_die(), SLASH, T, TL, TR, and X.
Referenced by s_rdfe(), s_rsfe(), and s_rsfi().
00528 { 00529 switch(p->op) 00530 { 00531 default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op); 00532 sig_die(f__fmtbuf, 1); 00533 case APOS: 00534 return(rd_POS(p->p2.s)); 00535 case H: return(rd_H(p->p1,p->p2.s)); 00536 case SLASH: return((*f__donewrec)()); 00537 case TR: 00538 case X: f__cursor += p->p1; 00539 return(1); 00540 case T: f__cursor=p->p1-f__recpos - 1; 00541 return(1); 00542 case TL: f__cursor -= p->p1; 00543 if(f__cursor < -f__recpos) /* TL1000, 1X */ 00544 f__cursor = -f__recpos; 00545 return(1); 00546 } 00547 }
Here is the call graph for this function:
Here is the caller graph for this function:
| static int rd_POS | ( | char * | s | ) | [static] |
Definition at line 445 of file rdfmt.c.
References f__getn, and quote.
Referenced by rd_ned().
00447 { char quote; 00448 int ch; 00449 quote= *s++; 00450 for(;*s;s++) 00451 if(*s==quote && *(s+1)!=quote) break; 00452 else if((ch=(*f__getn)())<0) return(ch); 00453 else *s = ch=='\n'?' ':ch; 00454 return(1); 00455 }
Here is the caller graph for this function:
Definition at line 24 of file rdfmt.c.
References errno, GET, i, int, n, s, s1, t, and x.
Referenced by rd_ed().
00026 { 00027 long x[9]; 00028 char *s, *s0, *s1, *se, *t; 00029 int ch, i, w1, w2; 00030 static char hex[256]; 00031 static int one = 1; 00032 int bad = 0; 00033 00034 if (!hex['0']) { 00035 s = "0123456789"; 00036 while(ch = *s++) 00037 hex[ch] = ch - '0' + 1; 00038 s = "ABCDEF"; 00039 while(ch = *s++) 00040 hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11; 00041 } 00042 s = s0 = (char *)x; 00043 s1 = (char *)&x[4]; 00044 se = (char *)&x[8]; 00045 if (len > 4*sizeof(long)) 00046 return errno = 117; 00047 while (w) { 00048 GET(ch); 00049 if (ch==',' || ch=='\n') 00050 break; 00051 w--; 00052 if (ch > ' ') { 00053 if (!hex[ch & 0xff]) 00054 bad++; 00055 *s++ = ch; 00056 if (s == se) { 00057 /* discard excess characters */ 00058 for(t = s0, s = s1; t < s1;) 00059 *t++ = *s++; 00060 s = s1; 00061 } 00062 } 00063 } 00064 if (bad) 00065 return errno = 115; 00066 w = (int)len; 00067 w1 = s - s0; 00068 w2 = (w1+1) >> 1; 00069 t = (char *)n; 00070 if (*(char *)&one) { 00071 /* little endian */ 00072 t += w - 1; 00073 i = -1; 00074 } 00075 else 00076 i = 1; 00077 for(; w > w2; t += i, --w) 00078 *t = 0; 00079 if (!w) 00080 return 0; 00081 if (w < w2) 00082 s0 = s - (w << 1); 00083 else if (w1 & 1) { 00084 *t = hex[*s0++ & 0xff] - 1; 00085 if (!--w) 00086 return 0; 00087 t += i; 00088 } 00089 do { 00090 *t = (hex[*s0 & 0xff]-1) << 4 | hex[s0[1] & 0xff]-1; 00091 t += i; 00092 s0 += 2; 00093 } 00094 while(--w); 00095 return 0; 00096 }
Here is the caller graph for this function:
1.5.1
