| 1 | #include "config.h"
|
|---|
| 2 | #include <ctype.h>
|
|---|
| 3 | #include "f2c.h"
|
|---|
| 4 | #include "fio.h"
|
|---|
| 5 |
|
|---|
| 6 | extern int f__cursor;
|
|---|
| 7 | #ifdef KR_headers
|
|---|
| 8 | extern double atof();
|
|---|
| 9 | #else
|
|---|
| 10 | #undef abs
|
|---|
| 11 | #undef min
|
|---|
| 12 | #undef max
|
|---|
| 13 | #include <stdlib.h>
|
|---|
| 14 | #endif
|
|---|
| 15 |
|
|---|
| 16 | #include "fmt.h"
|
|---|
| 17 | #include "fp.h"
|
|---|
| 18 |
|
|---|
| 19 | static int
|
|---|
| 20 | #ifdef KR_headers
|
|---|
| 21 | rd_Z(n,w,len) Uint *n; ftnlen len;
|
|---|
| 22 | #else
|
|---|
| 23 | rd_Z(Uint *n, int w, ftnlen len)
|
|---|
| 24 | #endif
|
|---|
| 25 | {
|
|---|
| 26 | long x[9];
|
|---|
| 27 | char *s, *s0, *s1, *se, *t;
|
|---|
| 28 | int ch, i, w1, w2;
|
|---|
| 29 | static char hex[256];
|
|---|
| 30 | static int one = 1;
|
|---|
| 31 | int bad = 0;
|
|---|
| 32 |
|
|---|
| 33 | if (!hex['0']) {
|
|---|
| 34 | s = "0123456789";
|
|---|
| 35 | while(ch = *s++)
|
|---|
| 36 | hex[ch] = ch - '0' + 1;
|
|---|
| 37 | s = "ABCDEF";
|
|---|
| 38 | while(ch = *s++)
|
|---|
| 39 | hex[ch] = hex[ch + 'a' - 'A'] = ch - 'A' + 11;
|
|---|
| 40 | }
|
|---|
| 41 | s = s0 = (char *)x;
|
|---|
| 42 | s1 = (char *)&x[4];
|
|---|
| 43 | se = (char *)&x[8];
|
|---|
| 44 | if (len > 4*sizeof(long))
|
|---|
| 45 | return errno = 117;
|
|---|
| 46 | while (w) {
|
|---|
| 47 | GET(ch);
|
|---|
| 48 | if (ch==',' || ch=='\n')
|
|---|
| 49 | break;
|
|---|
| 50 | w--;
|
|---|
| 51 | if (ch > ' ') {
|
|---|
| 52 | if (!hex[ch & 0xff])
|
|---|
| 53 | bad++;
|
|---|
| 54 | *s++ = ch;
|
|---|
| 55 | if (s == se) {
|
|---|
| 56 | /* discard excess characters */
|
|---|
| 57 | for(t = s0, s = s1; t < s1;)
|
|---|
| 58 | *t++ = *s++;
|
|---|
| 59 | s = s1;
|
|---|
| 60 | }
|
|---|
| 61 | }
|
|---|
| 62 | }
|
|---|
| 63 | if (bad)
|
|---|
| 64 | return errno = 115;
|
|---|
| 65 | w = (int)len;
|
|---|
| 66 | w1 = s - s0;
|
|---|
| 67 | w2 = w1+1 >> 1;
|
|---|
| 68 | t = (char *)n;
|
|---|
| 69 | if (*(char *)&one) {
|
|---|
| 70 | /* little endian */
|
|---|
| 71 | t += w - 1;
|
|---|
| 72 | i = -1;
|
|---|
| 73 | }
|
|---|
| 74 | else
|
|---|
| 75 | i = 1;
|
|---|
| 76 | for(; w > w2; t += i, --w)
|
|---|
| 77 | *t = 0;
|
|---|
| 78 | if (!w)
|
|---|
| 79 | return 0;
|
|---|
| 80 | if (w < w2)
|
|---|
| 81 | s0 = s - (w << 1);
|
|---|
| 82 | else if (w1 & 1) {
|
|---|
| 83 | *t = hex[*s0++ & 0xff] - 1;
|
|---|
| 84 | if (!--w)
|
|---|
| 85 | return 0;
|
|---|
| 86 | t += i;
|
|---|
| 87 | }
|
|---|
| 88 | do {
|
|---|
| 89 | *t = hex[*s0 & 0xff]-1 << 4 | hex[s0[1] & 0xff]-1;
|
|---|
| 90 | t += i;
|
|---|
| 91 | s0 += 2;
|
|---|
| 92 | }
|
|---|
| 93 | while(--w);
|
|---|
| 94 | return 0;
|
|---|
| 95 | }
|
|---|
| 96 |
|
|---|
| 97 | static int
|
|---|
| 98 | #ifdef KR_headers
|
|---|
| 99 | rd_I(n,w,len, base) Uint *n; int w; ftnlen len; register int base;
|
|---|
| 100 | #else
|
|---|
| 101 | rd_I(Uint *n, int w, ftnlen len, register int base)
|
|---|
| 102 | #endif
|
|---|
| 103 | {
|
|---|
| 104 | int bad, ch, sign;
|
|---|
| 105 | longint x = 0;
|
|---|
| 106 |
|
|---|
| 107 | if (w <= 0)
|
|---|
| 108 | goto have_x;
|
|---|
| 109 | for(;;) {
|
|---|
| 110 | GET(ch);
|
|---|
| 111 | if (ch != ' ')
|
|---|
| 112 | break;
|
|---|
| 113 | if (!--w)
|
|---|
| 114 | goto have_x;
|
|---|
| 115 | }
|
|---|
| 116 | sign = 0;
|
|---|
| 117 | switch(ch) {
|
|---|
| 118 | case ',':
|
|---|
| 119 | case '\n':
|
|---|
| 120 | w = 0;
|
|---|
| 121 | goto have_x;
|
|---|
| 122 | case '-':
|
|---|
| 123 | sign = 1;
|
|---|
| 124 | case '+':
|
|---|
| 125 | break;
|
|---|
| 126 | default:
|
|---|
| 127 | if (ch >= '0' && ch <= '9') {
|
|---|
| 128 | x = ch - '0';
|
|---|
| 129 | break;
|
|---|
| 130 | }
|
|---|
| 131 | goto have_x;
|
|---|
| 132 | }
|
|---|
| 133 | while(--w) {
|
|---|
| 134 | GET(ch);
|
|---|
| 135 | if (ch >= '0' && ch <= '9') {
|
|---|
| 136 | x = x*base + ch - '0';
|
|---|
| 137 | continue;
|
|---|
| 138 | }
|
|---|
| 139 | if (ch != ' ') {
|
|---|
| 140 | if (ch == '\n' || ch == ',')
|
|---|
| 141 | w = 0;
|
|---|
| 142 | break;
|
|---|
| 143 | }
|
|---|
| 144 | if (f__cblank)
|
|---|
| 145 | x *= base;
|
|---|
| 146 | }
|
|---|
| 147 | if (sign)
|
|---|
| 148 | x = -x;
|
|---|
| 149 | have_x:
|
|---|
| 150 | if(len == sizeof(integer))
|
|---|
| 151 | n->il=x;
|
|---|
| 152 | else if(len == sizeof(char))
|
|---|
| 153 | n->ic = (char)x;
|
|---|
| 154 | #ifdef Allow_TYQUAD
|
|---|
| 155 | else if (len == sizeof(longint))
|
|---|
| 156 | n->ili = x;
|
|---|
| 157 | #endif
|
|---|
| 158 | else
|
|---|
| 159 | n->is = (short)x;
|
|---|
| 160 | if (w) {
|
|---|
| 161 | while(--w)
|
|---|
| 162 | GET(ch);
|
|---|
| 163 | return errno = 115;
|
|---|
| 164 | }
|
|---|
| 165 | return 0;
|
|---|
| 166 | }
|
|---|
| 167 |
|
|---|
| 168 | static int
|
|---|
| 169 | #ifdef KR_headers
|
|---|
| 170 | rd_L(n,w,len) ftnint *n; ftnlen len;
|
|---|
| 171 | #else
|
|---|
| 172 | rd_L(ftnint *n, int w, ftnlen len)
|
|---|
| 173 | #endif
|
|---|
| 174 | { int ch, dot, lv;
|
|---|
| 175 |
|
|---|
| 176 | if (w <= 0)
|
|---|
| 177 | goto bad;
|
|---|
| 178 | for(;;) {
|
|---|
| 179 | GET(ch);
|
|---|
| 180 | --w;
|
|---|
| 181 | if (ch != ' ')
|
|---|
| 182 | break;
|
|---|
| 183 | if (!w)
|
|---|
| 184 | goto bad;
|
|---|
| 185 | }
|
|---|
| 186 | dot = 0;
|
|---|
| 187 | retry:
|
|---|
| 188 | switch(ch) {
|
|---|
| 189 | case '.':
|
|---|
| 190 | if (dot++ || !w)
|
|---|
| 191 | goto bad;
|
|---|
| 192 | GET(ch);
|
|---|
| 193 | --w;
|
|---|
| 194 | goto retry;
|
|---|
| 195 | case 't':
|
|---|
| 196 | case 'T':
|
|---|
| 197 | lv = 1;
|
|---|
| 198 | break;
|
|---|
| 199 | case 'f':
|
|---|
| 200 | case 'F':
|
|---|
| 201 | lv = 0;
|
|---|
| 202 | break;
|
|---|
| 203 | default:
|
|---|
| 204 | bad:
|
|---|
| 205 | for(; w > 0; --w)
|
|---|
| 206 | GET(ch);
|
|---|
| 207 | /* no break */
|
|---|
| 208 | case ',':
|
|---|
| 209 | case '\n':
|
|---|
| 210 | return errno = 116;
|
|---|
| 211 | }
|
|---|
| 212 | /* The switch statement that was here
|
|---|
| 213 | didn't cut it: It broke down for targets
|
|---|
| 214 | where sizeof(char) == sizeof(short). */
|
|---|
| 215 | if (len == sizeof(char))
|
|---|
| 216 | *(char *)n = (char)lv;
|
|---|
| 217 | else if (len == sizeof(short))
|
|---|
| 218 | *(short *)n = (short)lv;
|
|---|
| 219 | else
|
|---|
| 220 | *n = lv;
|
|---|
| 221 | while(w-- > 0) {
|
|---|
| 222 | GET(ch);
|
|---|
| 223 | if (ch == ',' || ch == '\n')
|
|---|
| 224 | break;
|
|---|
| 225 | }
|
|---|
| 226 | return 0;
|
|---|
| 227 | }
|
|---|
| 228 |
|
|---|
| 229 | static int
|
|---|
| 230 | #ifdef KR_headers
|
|---|
| 231 | rd_F(p, w, d, len) ufloat *p; ftnlen len;
|
|---|
| 232 | #else
|
|---|
| 233 | rd_F(ufloat *p, int w, int d, ftnlen len)
|
|---|
| 234 | #endif
|
|---|
| 235 | {
|
|---|
| 236 | char s[FMAX+EXPMAXDIGS+4];
|
|---|
| 237 | register int ch;
|
|---|
| 238 | register char *sp, *spe, *sp1;
|
|---|
| 239 | double x;
|
|---|
| 240 | int scale1, se;
|
|---|
| 241 | long e, exp;
|
|---|
| 242 |
|
|---|
| 243 | sp1 = sp = s;
|
|---|
| 244 | spe = sp + FMAX;
|
|---|
| 245 | exp = -d;
|
|---|
| 246 | x = 0.;
|
|---|
| 247 |
|
|---|
| 248 | do {
|
|---|
| 249 | GET(ch);
|
|---|
| 250 | w--;
|
|---|
| 251 | } while (ch == ' ' && w);
|
|---|
| 252 | switch(ch) {
|
|---|
| 253 | case '-': *sp++ = ch; sp1++; spe++;
|
|---|
| 254 | case '+':
|
|---|
| 255 | if (!w) goto zero;
|
|---|
| 256 | --w;
|
|---|
| 257 | GET(ch);
|
|---|
| 258 | }
|
|---|
| 259 | while(ch == ' ') {
|
|---|
| 260 | blankdrop:
|
|---|
| 261 | if (!w--) goto zero; GET(ch); }
|
|---|
| 262 | while(ch == '0')
|
|---|
| 263 | { if (!w--) goto zero; GET(ch); }
|
|---|
| 264 | if (ch == ' ' && f__cblank)
|
|---|
| 265 | goto blankdrop;
|
|---|
| 266 | scale1 = f__scale;
|
|---|
| 267 | while(isdigit(ch)) {
|
|---|
| 268 | digloop1:
|
|---|
| 269 | if (sp < spe) *sp++ = ch;
|
|---|
| 270 | else ++exp;
|
|---|
| 271 | digloop1e:
|
|---|
| 272 | if (!w--) goto done;
|
|---|
| 273 | GET(ch);
|
|---|
| 274 | }
|
|---|
| 275 | if (ch == ' ') {
|
|---|
| 276 | if (f__cblank)
|
|---|
| 277 | { ch = '0'; goto digloop1; }
|
|---|
| 278 | goto digloop1e;
|
|---|
| 279 | }
|
|---|
| 280 | if (ch == '.') {
|
|---|
| 281 | exp += d;
|
|---|
| 282 | if (!w--) goto done;
|
|---|
| 283 | GET(ch);
|
|---|
| 284 | if (sp == sp1) { /* no digits yet */
|
|---|
| 285 | while(ch == '0') {
|
|---|
| 286 | skip01:
|
|---|
| 287 | --exp;
|
|---|
| 288 | skip0:
|
|---|
| 289 | if (!w--) goto done;
|
|---|
| 290 | GET(ch);
|
|---|
| 291 | }
|
|---|
| 292 | if (ch == ' ') {
|
|---|
| 293 | if (f__cblank) goto skip01;
|
|---|
| 294 | goto skip0;
|
|---|
| 295 | }
|
|---|
| 296 | }
|
|---|
| 297 | while(isdigit(ch)) {
|
|---|
| 298 | digloop2:
|
|---|
| 299 | if (sp < spe)
|
|---|
| 300 | { *sp++ = ch; --exp; }
|
|---|
| 301 | digloop2e:
|
|---|
| 302 | if (!w--) goto done;
|
|---|
| 303 | GET(ch);
|
|---|
| 304 | }
|
|---|
| 305 | if (ch == ' ') {
|
|---|
| 306 | if (f__cblank)
|
|---|
| 307 | { ch = '0'; goto digloop2; }
|
|---|
| 308 | goto digloop2e;
|
|---|
| 309 | }
|
|---|
| 310 | }
|
|---|
| 311 | switch(ch) {
|
|---|
| 312 | default:
|
|---|
| 313 | break;
|
|---|
| 314 | case '-': se = 1; goto signonly;
|
|---|
| 315 | case '+': se = 0; goto signonly;
|
|---|
| 316 | case 'e':
|
|---|
| 317 | case 'E':
|
|---|
| 318 | case 'd':
|
|---|
| 319 | case 'D':
|
|---|
| 320 | if (!w--)
|
|---|
| 321 | goto bad;
|
|---|
| 322 | GET(ch);
|
|---|
| 323 | while(ch == ' ') {
|
|---|
| 324 | if (!w--)
|
|---|
| 325 | goto bad;
|
|---|
| 326 | GET(ch);
|
|---|
| 327 | }
|
|---|
| 328 | se = 0;
|
|---|
| 329 | switch(ch) {
|
|---|
| 330 | case '-': se = 1;
|
|---|
| 331 | case '+':
|
|---|
| 332 | signonly:
|
|---|
| 333 | if (!w--)
|
|---|
| 334 | goto bad;
|
|---|
| 335 | GET(ch);
|
|---|
| 336 | }
|
|---|
| 337 | while(ch == ' ') {
|
|---|
| 338 | if (!w--)
|
|---|
| 339 | goto bad;
|
|---|
| 340 | GET(ch);
|
|---|
| 341 | }
|
|---|
| 342 | if (!isdigit(ch))
|
|---|
| 343 | goto bad;
|
|---|
| 344 |
|
|---|
| 345 | e = ch - '0';
|
|---|
| 346 | for(;;) {
|
|---|
| 347 | if (!w--)
|
|---|
| 348 | { ch = '\n'; break; }
|
|---|
| 349 | GET(ch);
|
|---|
| 350 | if (!isdigit(ch)) {
|
|---|
| 351 | if (ch == ' ') {
|
|---|
| 352 | if (f__cblank)
|
|---|
| 353 | ch = '0';
|
|---|
| 354 | else continue;
|
|---|
| 355 | }
|
|---|
| 356 | else
|
|---|
| 357 | break;
|
|---|
| 358 | }
|
|---|
| 359 | e = 10*e + ch - '0';
|
|---|
| 360 | if (e > EXPMAX && sp > sp1)
|
|---|
| 361 | goto bad;
|
|---|
| 362 | }
|
|---|
| 363 | if (se)
|
|---|
| 364 | exp -= e;
|
|---|
| 365 | else
|
|---|
| 366 | exp += e;
|
|---|
| 367 | scale1 = 0;
|
|---|
| 368 | }
|
|---|
| 369 | switch(ch) {
|
|---|
| 370 | case '\n':
|
|---|
| 371 | case ',':
|
|---|
| 372 | break;
|
|---|
| 373 | default:
|
|---|
| 374 | bad:
|
|---|
| 375 | return (errno = 115);
|
|---|
| 376 | }
|
|---|
| 377 | done:
|
|---|
| 378 | if (sp > sp1) {
|
|---|
| 379 | while(*--sp == '0')
|
|---|
| 380 | ++exp;
|
|---|
| 381 | if (exp -= scale1)
|
|---|
| 382 | sprintf(sp+1, "e%ld", exp);
|
|---|
| 383 | else
|
|---|
| 384 | sp[1] = 0;
|
|---|
| 385 | x = atof(s);
|
|---|
| 386 | }
|
|---|
| 387 | zero:
|
|---|
| 388 | if (len == sizeof(real))
|
|---|
| 389 | p->pf = x;
|
|---|
| 390 | else
|
|---|
| 391 | p->pd = x;
|
|---|
| 392 | return(0);
|
|---|
| 393 | }
|
|---|
| 394 |
|
|---|
| 395 |
|
|---|
| 396 | static int
|
|---|
| 397 | #ifdef KR_headers
|
|---|
| 398 | rd_A(p,len) char *p; ftnlen len;
|
|---|
| 399 | #else
|
|---|
| 400 | rd_A(char *p, ftnlen len)
|
|---|
| 401 | #endif
|
|---|
| 402 | { int i,ch;
|
|---|
| 403 | for(i=0;i<len;i++)
|
|---|
| 404 | { GET(ch);
|
|---|
| 405 | *p++=VAL(ch);
|
|---|
| 406 | }
|
|---|
| 407 | return(0);
|
|---|
| 408 | }
|
|---|
| 409 | static int
|
|---|
| 410 | #ifdef KR_headers
|
|---|
| 411 | rd_AW(p,w,len) char *p; ftnlen len;
|
|---|
| 412 | #else
|
|---|
| 413 | rd_AW(char *p, int w, ftnlen len)
|
|---|
| 414 | #endif
|
|---|
| 415 | { int i,ch;
|
|---|
| 416 | if(w>=len)
|
|---|
| 417 | { for(i=0;i<w-len;i++)
|
|---|
| 418 | GET(ch);
|
|---|
| 419 | for(i=0;i<len;i++)
|
|---|
| 420 | { GET(ch);
|
|---|
| 421 | *p++=VAL(ch);
|
|---|
| 422 | }
|
|---|
| 423 | return(0);
|
|---|
| 424 | }
|
|---|
| 425 | for(i=0;i<w;i++)
|
|---|
| 426 | { GET(ch);
|
|---|
| 427 | *p++=VAL(ch);
|
|---|
| 428 | }
|
|---|
| 429 | for(i=0;i<len-w;i++) *p++=' ';
|
|---|
| 430 | return(0);
|
|---|
| 431 | }
|
|---|
| 432 | static int
|
|---|
| 433 | #ifdef KR_headers
|
|---|
| 434 | rd_H(n,s) char *s;
|
|---|
| 435 | #else
|
|---|
| 436 | rd_H(int n, char *s)
|
|---|
| 437 | #endif
|
|---|
| 438 | { int i,ch;
|
|---|
| 439 | for(i=0;i<n;i++)
|
|---|
| 440 | if((ch=(*f__getn)())<0) return(ch);
|
|---|
| 441 | else *s++ = ch=='\n'?' ':ch;
|
|---|
| 442 | return(1);
|
|---|
| 443 | }
|
|---|
| 444 | static int
|
|---|
| 445 | #ifdef KR_headers
|
|---|
| 446 | rd_POS(s) char *s;
|
|---|
| 447 | #else
|
|---|
| 448 | rd_POS(char *s)
|
|---|
| 449 | #endif
|
|---|
| 450 | { char quote;
|
|---|
| 451 | int ch;
|
|---|
| 452 | quote= *s++;
|
|---|
| 453 | for(;*s;s++)
|
|---|
| 454 | if(*s==quote && *(s+1)!=quote) break;
|
|---|
| 455 | else if((ch=(*f__getn)())<0) return(ch);
|
|---|
| 456 | else *s = ch=='\n'?' ':ch;
|
|---|
| 457 | return(1);
|
|---|
| 458 | }
|
|---|
| 459 | #ifdef KR_headers
|
|---|
| 460 | rd_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
|
|---|
| 461 | #else
|
|---|
| 462 | rd_ed(struct syl *p, char *ptr, ftnlen len)
|
|---|
| 463 | #endif
|
|---|
| 464 | { int ch;
|
|---|
| 465 | for(;f__cursor>0;f__cursor--) if((ch=(*f__getn)())<0) return(ch);
|
|---|
| 466 | if(f__cursor<0)
|
|---|
| 467 | { if(f__recpos+f__cursor < 0) /*err(elist->cierr,110,"fmt")*/
|
|---|
| 468 | f__cursor = -f__recpos; /* is this in the standard? */
|
|---|
| 469 | if(f__external == 0) {
|
|---|
| 470 | extern char *f__icptr;
|
|---|
| 471 | f__icptr += f__cursor;
|
|---|
| 472 | }
|
|---|
| 473 | else if(f__curunit && f__curunit->useek)
|
|---|
| 474 | FSEEK(f__cf,(off_t)f__cursor,SEEK_CUR);
|
|---|
| 475 | else
|
|---|
| 476 | err(f__elist->cierr,106,"fmt");
|
|---|
| 477 | f__recpos += f__cursor;
|
|---|
| 478 | f__cursor=0;
|
|---|
| 479 | }
|
|---|
| 480 | switch(p->op)
|
|---|
| 481 | {
|
|---|
| 482 | default: fprintf(stderr,"rd_ed, unexpected code: %d\n", p->op);
|
|---|
| 483 | sig_die(f__fmtbuf, 1);
|
|---|
| 484 | case IM:
|
|---|
| 485 | case I: ch = rd_I((Uint *)ptr,p->p1,len, 10);
|
|---|
| 486 | break;
|
|---|
| 487 |
|
|---|
| 488 | /* O and OM don't work right for character, double, complex, */
|
|---|
| 489 | /* or doublecomplex, and they differ from Fortran 90 in */
|
|---|
| 490 | /* showing a minus sign for negative values. */
|
|---|
| 491 |
|
|---|
| 492 | case OM:
|
|---|
| 493 | case O: ch = rd_I((Uint *)ptr, p->p1, len, 8);
|
|---|
| 494 | break;
|
|---|
| 495 | case L: ch = rd_L((ftnint *)ptr,p->p1,len);
|
|---|
| 496 | break;
|
|---|
| 497 | case A: ch = rd_A(ptr,len);
|
|---|
| 498 | break;
|
|---|
| 499 | case AW:
|
|---|
| 500 | ch = rd_AW(ptr,p->p1,len);
|
|---|
| 501 | break;
|
|---|
| 502 | case E: case EE:
|
|---|
| 503 | case D:
|
|---|
| 504 | case G:
|
|---|
| 505 | case GE:
|
|---|
| 506 | case F: ch = rd_F((ufloat *)ptr,p->p1,p->p2.i[0],len);
|
|---|
| 507 | break;
|
|---|
| 508 |
|
|---|
| 509 | /* Z and ZM assume 8-bit bytes. */
|
|---|
| 510 |
|
|---|
| 511 | case ZM:
|
|---|
| 512 | case Z:
|
|---|
| 513 | ch = rd_Z((Uint *)ptr, p->p1, len);
|
|---|
| 514 | break;
|
|---|
| 515 | }
|
|---|
| 516 | if(ch == 0) return(ch);
|
|---|
| 517 | else if(ch == EOF) return(EOF);
|
|---|
| 518 | if (f__cf)
|
|---|
| 519 | clearerr(f__cf);
|
|---|
| 520 | return(errno);
|
|---|
| 521 | }
|
|---|
| 522 | #ifdef KR_headers
|
|---|
| 523 | rd_ned(p) struct syl *p;
|
|---|
| 524 | #else
|
|---|
| 525 | rd_ned(struct syl *p)
|
|---|
| 526 | #endif
|
|---|
| 527 | {
|
|---|
| 528 | switch(p->op)
|
|---|
| 529 | {
|
|---|
| 530 | default: fprintf(stderr,"rd_ned, unexpected code: %d\n", p->op);
|
|---|
| 531 | sig_die(f__fmtbuf, 1);
|
|---|
| 532 | case APOS:
|
|---|
| 533 | return(rd_POS(p->p2.s));
|
|---|
| 534 | case H: return(rd_H(p->p1,p->p2.s));
|
|---|
| 535 | case SLASH: return((*f__donewrec)());
|
|---|
| 536 | case TR:
|
|---|
| 537 | case X: f__cursor += p->p1;
|
|---|
| 538 | return(1);
|
|---|
| 539 | case T: f__cursor=p->p1-f__recpos - 1;
|
|---|
| 540 | return(1);
|
|---|
| 541 | case TL: f__cursor -= p->p1;
|
|---|
| 542 | if(f__cursor < -f__recpos) /* TL1000, 1X */
|
|---|
| 543 | f__cursor = -f__recpos;
|
|---|
| 544 | return(1);
|
|---|
| 545 | }
|
|---|
| 546 | }
|
|---|
