![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to pread.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f2c|
Return to pread.c CVS log | Up to [Research Unix] / researchv10no / cmd / f2c |
1.1 ! root 1: /**************************************************************** ! 2: Copyright 1990, 1992, 1993 by AT&T Bell Laboratories and Bellcore. ! 3: ! 4: Permission to use, copy, modify, and distribute this software ! 5: and its documentation for any purpose and without fee is hereby ! 6: granted, provided that the above copyright notice appear in all ! 7: copies and that both that the copyright notice and this ! 8: permission notice and warranty disclaimer appear in supporting ! 9: documentation, and that the names of AT&T Bell Laboratories or ! 10: Bellcore or any of their entities not be used in advertising or ! 11: publicity pertaining to distribution of the software without ! 12: specific, written prior permission. ! 13: ! 14: AT&T and Bellcore disclaim all warranties with regard to this ! 15: software, including all implied warranties of merchantability ! 16: and fitness. In no event shall AT&T or Bellcore be liable for ! 17: any special, indirect or consequential damages or any damages ! 18: whatsoever resulting from loss of use, data or profits, whether ! 19: in an action of contract, negligence or other tortious action, ! 20: arising out of or in connection with the use or performance of ! 21: this software. ! 22: ****************************************************************/ ! 23: ! 24: #include "defs.h" ! 25: ! 26: static char Ptok[128], Pct[Table_size]; ! 27: static char *Pfname; ! 28: static long Plineno; ! 29: static int Pbad; ! 30: static int *tfirst, *tlast, *tnext, tmax; ! 31: ! 32: #define P_space 1 ! 33: #define P_anum 2 ! 34: #define P_delim 3 ! 35: #define P_slash 4 ! 36: ! 37: #define TGULP 100 ! 38: ! 39: static void ! 40: trealloc() ! 41: { ! 42: int k = tmax; ! 43: tfirst = (int *)realloc((char *)tfirst, ! 44: (tmax += TGULP)*sizeof(int)); ! 45: if (!tfirst) { ! 46: fprintf(stderr, ! 47: "Pfile: realloc failure!\n"); ! 48: exit(2); ! 49: } ! 50: tlast = tfirst + tmax; ! 51: tnext = tfirst + k; ! 52: } ! 53: ! 54: static void ! 55: badchar(c) ! 56: int c; ! 57: { ! 58: fprintf(stderr, ! 59: "unexpected character 0x%.2x = '%c' on line %ld of %s\n", ! 60: c, c, Plineno, Pfname); ! 61: exit(2); ! 62: } ! 63: ! 64: static void ! 65: bad_type() ! 66: { ! 67: fprintf(stderr, ! 68: "unexpected type \"%s\" on line %ld of %s\n", ! 69: Ptok, Plineno, Pfname); ! 70: exit(2); ! 71: } ! 72: ! 73: static void ! 74: badflag(tname, option) ! 75: char *tname, *option; ! 76: { ! 77: fprintf(stderr, "%s type from `f2c -%s` on line %ld of %s\n", ! 78: tname, option, Plineno, Pfname); ! 79: Pbad++; ! 80: } ! 81: ! 82: static void ! 83: detected(msg) ! 84: char *msg; ! 85: { ! 86: fprintf(stderr, ! 87: "%sdetected on line %ld of %s\n", msg, Plineno, Pfname); ! 88: Pbad++; ! 89: } ! 90: ! 91: #if 0 ! 92: static void ! 93: checklogical(k) ! 94: int k; ! 95: { ! 96: static int lastmsg = 0; ! 97: static int seen[2] = {0,0}; ! 98: ! 99: seen[k] = 1; ! 100: if (seen[1-k]) { ! 101: if (lastmsg < 3) { ! 102: lastmsg = 3; ! 103: detected( ! 104: "Illegal combination of LOGICAL types -- mixing -I4 with -I2 or -i2\n\t"); ! 105: } ! 106: return; ! 107: } ! 108: if (k) { ! 109: if (tylogical == TYLONG || lastmsg >= 2) ! 110: return; ! 111: if (!lastmsg) { ! 112: lastmsg = 2; ! 113: badflag("LOGICAL", "I4"); ! 114: } ! 115: } ! 116: else { ! 117: if (tylogical == TYSHORT || lastmsg & 1) ! 118: return; ! 119: if (!lastmsg) { ! 120: lastmsg = 1; ! 121: badflag("LOGICAL", "i2` or `f2c -I2"); ! 122: } ! 123: } ! 124: } ! 125: #else ! 126: #define checklogical(n) /* */ ! 127: #endif ! 128: ! 129: static void ! 130: checkreal(k) ! 131: { ! 132: static int warned = 0; ! 133: static int seen[2] = {0,0}; ! 134: ! 135: seen[k] = 1; ! 136: if (seen[1-k]) { ! 137: if (warned < 2) ! 138: detected("Illegal mixture of -R and -!R "); ! 139: warned = 2; ! 140: return; ! 141: } ! 142: if (k == forcedouble || warned) ! 143: return; ! 144: warned = 1; ! 145: badflag("REAL return", k ? "!R" : "R"); ! 146: } ! 147: ! 148: static void ! 149: Pnotboth(e) ! 150: Extsym *e; ! 151: { ! 152: if (e->curno) ! 153: return; ! 154: Pbad++; ! 155: e->curno = 1; ! 156: fprintf(stderr, ! 157: "%s cannot be both a procedure and a common block (line %ld of %s)\n", ! 158: e->fextname, Plineno, Pfname); ! 159: } ! 160: ! 161: static int ! 162: numread(pf, n) ! 163: register FILE *pf; ! 164: int *n; ! 165: { ! 166: register int c, k; ! 167: ! 168: if ((c = getc(pf)) < '0' || c > '9') ! 169: return c; ! 170: k = c - '0'; ! 171: for(;;) { ! 172: if ((c = getc(pf)) == ' ') { ! 173: *n = k; ! 174: return c; ! 175: } ! 176: if (c < '0' || c > '9') ! 177: break; ! 178: k = 10*k + c - '0'; ! 179: } ! 180: return c; ! 181: } ! 182: ! 183: static void argverify(), Pbadret(); ! 184: ! 185: static int ! 186: readref(pf, e, ftype) ! 187: register FILE *pf; ! 188: Extsym *e; ! 189: int ftype; ! 190: { ! 191: register int c, *t; ! 192: int i, nargs, type; ! 193: Argtypes *at; ! 194: Atype *a, *ae; ! 195: ! 196: if (ftype > TYSUBR) ! 197: return 0; ! 198: if ((c = numread(pf, &nargs)) != ' ') { ! 199: if (c != ':') ! 200: return c == EOF; ! 201: /* just a typed external */ ! 202: if (e->extstg == STGUNKNOWN) { ! 203: at = 0; ! 204: goto justsym; ! 205: } ! 206: if (e->extstg == STGEXT) { ! 207: if (e->extype != ftype) ! 208: Pbadret(ftype, e); ! 209: } ! 210: else ! 211: Pnotboth(e); ! 212: return 0; ! 213: } ! 214: ! 215: tnext = tfirst; ! 216: for(i = 0; i < nargs; i++) { ! 217: if ((c = numread(pf, &type)) != ' ' ! 218: || type >= 500 ! 219: || type != TYFTNLEN + 100 && type % 100 > TYSUBR) ! 220: return c == EOF; ! 221: if (tnext >= tlast) ! 222: trealloc(); ! 223: *tnext++ = type; ! 224: } ! 225: ! 226: if (e->extstg == STGUNKNOWN) { ! 227: save_at: ! 228: at = (Argtypes *) ! 229: gmem(sizeof(Argtypes) + (nargs-1)*sizeof(Atype), 1); ! 230: at->dnargs = at->nargs = nargs; ! 231: at->changes = 0; ! 232: t = tfirst; ! 233: a = at->atypes; ! 234: for(ae = a + nargs; a < ae; a++) { ! 235: a->type = *t++; ! 236: a->cp = 0; ! 237: } ! 238: justsym: ! 239: e->extstg = STGEXT; ! 240: e->extype = ftype; ! 241: e->arginfo = at; ! 242: } ! 243: else if (e->extstg != STGEXT) { ! 244: Pnotboth(e); ! 245: } ! 246: else if (!e->arginfo) { ! 247: if (e->extype != ftype) ! 248: Pbadret(ftype, e); ! 249: else ! 250: goto save_at; ! 251: } ! 252: else ! 253: argverify(ftype, e); ! 254: return 0; ! 255: } ! 256: ! 257: static int ! 258: comlen(pf) ! 259: register FILE *pf; ! 260: { ! 261: register int c; ! 262: register char *s, *se; ! 263: char buf[128], cbuf[128]; ! 264: int refread; ! 265: long L; ! 266: Extsym *e; ! 267: ! 268: if ((c = getc(pf)) == EOF) ! 269: return 1; ! 270: if (c == ' ') { ! 271: refread = 0; ! 272: s = "comlen "; ! 273: } ! 274: else if (c == ':') { ! 275: refread = 1; ! 276: s = "ref: "; ! 277: } ! 278: else { ! 279: ret0: ! 280: if (c == '*') ! 281: ungetc(c,pf); ! 282: return 0; ! 283: } ! 284: while(*s) { ! 285: if ((c = getc(pf)) == EOF) ! 286: return 1; ! 287: if (c != *s++) ! 288: goto ret0; ! 289: } ! 290: s = buf; ! 291: se = buf + sizeof(buf) - 1; ! 292: for(;;) { ! 293: if ((c = getc(pf)) == EOF) ! 294: return 1; ! 295: if (c == ' ') ! 296: break; ! 297: if (s >= se || Pct[c] != P_anum) ! 298: goto ret0; ! 299: *s++ = c; ! 300: } ! 301: *s-- = 0; ! 302: if (s <= buf || *s != '_') ! 303: return 0; ! 304: strcpy(cbuf,buf); ! 305: *s-- = 0; ! 306: if (*s == '_') { ! 307: *s-- = 0; ! 308: if (s <= buf) ! 309: return 0; ! 310: } ! 311: for(L = 0;;) { ! 312: if ((c = getc(pf)) == EOF) ! 313: return 1; ! 314: if (c == ' ') ! 315: break; ! 316: if (c < '0' && c > '9') ! 317: goto ret0; ! 318: L = 10*L + c - '0'; ! 319: } ! 320: if (!L && !refread) ! 321: return 0; ! 322: e = mkext(buf, cbuf); ! 323: if (refread) ! 324: return readref(pf, e, (int)L); ! 325: if (e->extstg == STGUNKNOWN) { ! 326: e->extstg = STGCOMMON; ! 327: e->maxleng = L; ! 328: } ! 329: else if (e->extstg != STGCOMMON) ! 330: Pnotboth(e); ! 331: else if (e->maxleng != L) { ! 332: fprintf(stderr, ! 333: "incompatible lengths for common block %s (line %ld of %s)\n", ! 334: buf, Plineno, Pfname); ! 335: if (e->maxleng < L) ! 336: e->maxleng = L; ! 337: } ! 338: return 0; ! 339: } ! 340: ! 341: static int ! 342: Ptoken(pf, canend) ! 343: FILE *pf; ! 344: int canend; ! 345: { ! 346: register int c; ! 347: register char *s, *se; ! 348: ! 349: top: ! 350: for(;;) { ! 351: c = getc(pf); ! 352: if (c == EOF) { ! 353: if (canend) ! 354: return 0; ! 355: goto badeof; ! 356: } ! 357: if (Pct[c] != P_space) ! 358: break; ! 359: if (c == '\n') ! 360: Plineno++; ! 361: } ! 362: switch(Pct[c]) { ! 363: case P_anum: ! 364: if (c == '_') ! 365: badchar(c); ! 366: s = Ptok; ! 367: se = s + sizeof(Ptok) - 1; ! 368: do { ! 369: if (s < se) ! 370: *s++ = c; ! 371: if ((c = getc(pf)) == EOF) { ! 372: badeof: ! 373: fprintf(stderr, ! 374: "unexpected end of file in %s\n", ! 375: Pfname); ! 376: exit(2); ! 377: } ! 378: } ! 379: while(Pct[c] == P_anum); ! 380: ungetc(c,pf); ! 381: *s = 0; ! 382: return P_anum; ! 383: ! 384: case P_delim: ! 385: return c; ! 386: ! 387: case P_slash: ! 388: if ((c = getc(pf)) != '*') { ! 389: if (c == EOF) ! 390: goto badeof; ! 391: badchar('/'); ! 392: } ! 393: if (canend && comlen(pf)) ! 394: goto badeof; ! 395: for(;;) { ! 396: while((c = getc(pf)) != '*') { ! 397: if (c == EOF) ! 398: goto badeof; ! 399: if (c == '\n') ! 400: Plineno++; ! 401: } ! 402: slashseek: ! 403: switch(getc(pf)) { ! 404: case '/': ! 405: goto top; ! 406: case EOF: ! 407: goto badeof; ! 408: case '*': ! 409: goto slashseek; ! 410: } ! 411: } ! 412: default: ! 413: badchar(c); ! 414: } ! 415: /* NOT REACHED */ ! 416: return 0; ! 417: } ! 418: ! 419: static int ! 420: Pftype() ! 421: { ! 422: switch(Ptok[0]) { ! 423: case 'C': ! 424: if (!strcmp(Ptok+1, "_f")) ! 425: return TYCOMPLEX; ! 426: break; ! 427: case 'E': ! 428: if (!strcmp(Ptok+1, "_f")) { ! 429: /* TYREAL under forcedouble */ ! 430: checkreal(1); ! 431: return TYREAL; ! 432: } ! 433: break; ! 434: case 'H': ! 435: if (!strcmp(Ptok+1, "_f")) ! 436: return TYCHAR; ! 437: break; ! 438: case 'Z': ! 439: if (!strcmp(Ptok+1, "_f")) ! 440: return TYDCOMPLEX; ! 441: break; ! 442: case 'd': ! 443: if (!strcmp(Ptok+1, "oublereal")) ! 444: return TYDREAL; ! 445: break; ! 446: case 'i': ! 447: if (!strcmp(Ptok+1, "nt")) ! 448: return TYSUBR; ! 449: if (!strcmp(Ptok+1, "nteger")) ! 450: return TYLONG; ! 451: if (!strcmp(Ptok+1, "nteger1")) ! 452: return TYINT1; ! 453: break; ! 454: case 'l': ! 455: if (!strcmp(Ptok+1, "ogical")) { ! 456: checklogical(1); ! 457: return TYLOGICAL; ! 458: } ! 459: if (!strcmp(Ptok+1, "ogical1")) ! 460: return TYLOGICAL1; ! 461: #ifdef TYQUAD ! 462: if (!strcmp(Ptok+1, "ongint")) ! 463: return TYQUAD; ! 464: #endif ! 465: break; ! 466: case 'r': ! 467: if (!strcmp(Ptok+1, "eal")) { ! 468: checkreal(0); ! 469: return TYREAL; ! 470: } ! 471: break; ! 472: case 's': ! 473: if (!strcmp(Ptok+1, "hortint")) ! 474: return TYSHORT; ! 475: if (!strcmp(Ptok+1, "hortlogical")) { ! 476: checklogical(0); ! 477: return TYLOGICAL2; ! 478: } ! 479: break; ! 480: } ! 481: bad_type(); ! 482: /* NOT REACHED */ ! 483: return 0; ! 484: } ! 485: ! 486: static void ! 487: wanted(i, what) ! 488: int i; ! 489: char *what; ! 490: { ! 491: if (i != P_anum) { ! 492: Ptok[0] = i; ! 493: Ptok[1] = 0; ! 494: } ! 495: fprintf(stderr,"Error: expected %s, not \"%s\" (line %ld of %s)\n", ! 496: what, Ptok, Plineno, Pfname); ! 497: exit(2); ! 498: } ! 499: ! 500: static int ! 501: Ptype(pf) ! 502: FILE *pf; ! 503: { ! 504: int i, rv; ! 505: ! 506: i = Ptoken(pf,0); ! 507: if (i == ')') ! 508: return 0; ! 509: if (i != P_anum) ! 510: badchar(i); ! 511: ! 512: rv = 0; ! 513: switch(Ptok[0]) { ! 514: case 'C': ! 515: if (!strcmp(Ptok+1, "_fp")) ! 516: rv = TYCOMPLEX+200; ! 517: break; ! 518: case 'D': ! 519: if (!strcmp(Ptok+1, "_fp")) ! 520: rv = TYDREAL+200; ! 521: break; ! 522: case 'E': ! 523: case 'R': ! 524: if (!strcmp(Ptok+1, "_fp")) ! 525: rv = TYREAL+200; ! 526: break; ! 527: case 'H': ! 528: if (!strcmp(Ptok+1, "_fp")) ! 529: rv = TYCHAR+200; ! 530: break; ! 531: case 'I': ! 532: if (!strcmp(Ptok+1, "_fp")) ! 533: rv = TYLONG+200; ! 534: else if (!strcmp(Ptok+1, "1_fp")) ! 535: rv = TYINT1+200; ! 536: #ifdef TYQUAD ! 537: else if (!strcmp(Ptok+1, "8_fp")) ! 538: rv = TYQUAD+200; ! 539: #endif ! 540: break; ! 541: case 'J': ! 542: if (!strcmp(Ptok+1, "_fp")) ! 543: rv = TYSHORT+200; ! 544: break; ! 545: case 'K': ! 546: checklogical(0); ! 547: goto Logical; ! 548: case 'L': ! 549: checklogical(1); ! 550: Logical: ! 551: if (!strcmp(Ptok+1, "_fp")) ! 552: rv = TYLOGICAL+200; ! 553: else if (!strcmp(Ptok+1, "1_fp")) ! 554: rv = TYLOGICAL1+200; ! 555: else if (!strcmp(Ptok+1, "2_fp")) ! 556: rv = TYLOGICAL2+200; ! 557: break; ! 558: case 'S': ! 559: if (!strcmp(Ptok+1, "_fp")) ! 560: rv = TYSUBR+200; ! 561: break; ! 562: case 'U': ! 563: if (!strcmp(Ptok+1, "_fp")) ! 564: rv = TYUNKNOWN+300; ! 565: break; ! 566: case 'Z': ! 567: if (!strcmp(Ptok+1, "_fp")) ! 568: rv = TYDCOMPLEX+200; ! 569: break; ! 570: case 'c': ! 571: if (!strcmp(Ptok+1, "har")) ! 572: rv = TYCHAR; ! 573: else if (!strcmp(Ptok+1, "omplex")) ! 574: rv = TYCOMPLEX; ! 575: break; ! 576: case 'd': ! 577: if (!strcmp(Ptok+1, "oublereal")) ! 578: rv = TYDREAL; ! 579: else if (!strcmp(Ptok+1, "oublecomplex")) ! 580: rv = TYDCOMPLEX; ! 581: break; ! 582: case 'f': ! 583: if (!strcmp(Ptok+1, "tnlen")) ! 584: rv = TYFTNLEN+100; ! 585: break; ! 586: case 'i': ! 587: if (!strcmp(Ptok+1, "nteger")) ! 588: rv = TYLONG; ! 589: break; ! 590: case 'l': ! 591: if (!strcmp(Ptok+1, "ogical")) { ! 592: checklogical(1); ! 593: rv = TYLOGICAL; ! 594: } ! 595: else if (!strcmp(Ptok+1, "ogical1")) ! 596: rv = TYLOGICAL1; ! 597: break; ! 598: case 'r': ! 599: if (!strcmp(Ptok+1, "eal")) ! 600: rv = TYREAL; ! 601: break; ! 602: case 's': ! 603: if (!strcmp(Ptok+1, "hortint")) ! 604: rv = TYSHORT; ! 605: else if (!strcmp(Ptok+1, "hortlogical")) { ! 606: checklogical(0); ! 607: rv = TYLOGICAL; ! 608: } ! 609: break; ! 610: case 'v': ! 611: if (tnext == tfirst && !strcmp(Ptok+1, "oid")) { ! 612: if ((i = Ptoken(pf,0)) != /*(*/ ')') ! 613: wanted(i, /*(*/ "\")\""); ! 614: return 0; ! 615: } ! 616: } ! 617: if (!rv) ! 618: bad_type(); ! 619: if (rv < 100 && (i = Ptoken(pf,0)) != '*') ! 620: wanted(i, "\"*\""); ! 621: if ((i = Ptoken(pf,0)) == P_anum) ! 622: i = Ptoken(pf,0); /* skip variable name */ ! 623: switch(i) { ! 624: case ')': ! 625: ungetc(i,pf); ! 626: break; ! 627: case ',': ! 628: break; ! 629: default: ! 630: wanted(i, "\",\" or \")\""); ! 631: } ! 632: return rv; ! 633: } ! 634: ! 635: static char * ! 636: trimunder() ! 637: { ! 638: register char *s; ! 639: register int n; ! 640: static char buf[128]; ! 641: ! 642: s = Ptok + strlen(Ptok) - 1; ! 643: if (*s != '_') { ! 644: fprintf(stderr, ! 645: "warning: %s does not end in _ (line %ld of %s)\n", ! 646: Ptok, Plineno, Pfname); ! 647: return Ptok; ! 648: } ! 649: if (s[-1] == '_') ! 650: s--; ! 651: strncpy(buf, Ptok, n = s - Ptok); ! 652: buf[n] = 0; ! 653: return buf; ! 654: } ! 655: ! 656: static void ! 657: Pbadmsg(msg, p) ! 658: char *msg; ! 659: Extsym *p; ! 660: { ! 661: Pbad++; ! 662: fprintf(stderr, "%s for %s (line %ld of %s):\n\t", msg, ! 663: p->fextname, Plineno, Pfname); ! 664: p->arginfo->nargs = -1; ! 665: } ! 666: ! 667: char *Argtype(); ! 668: ! 669: static void ! 670: Pbadret(ftype, p) ! 671: int ftype; ! 672: Extsym *p; ! 673: { ! 674: char buf1[32], buf2[32]; ! 675: ! 676: Pbadmsg("inconsistent types",p); ! 677: fprintf(stderr, "here %s, previously %s\n", ! 678: Argtype(ftype+200,buf1), ! 679: Argtype(p->extype+200,buf2)); ! 680: } ! 681: ! 682: static void ! 683: argverify(ftype, p) ! 684: int ftype; ! 685: Extsym *p; ! 686: { ! 687: Argtypes *at; ! 688: register Atype *aty; ! 689: int i, j, k; ! 690: register int *t, *te; ! 691: char buf1[32], buf2[32]; ! 692: int type_fixup(); ! 693: ! 694: at = p->arginfo; ! 695: if (at->nargs < 0) ! 696: return; ! 697: if (p->extype != ftype) { ! 698: Pbadret(ftype, p); ! 699: return; ! 700: } ! 701: t = tfirst; ! 702: te = tnext; ! 703: i = te - t; ! 704: if (at->nargs != i) { ! 705: j = at->nargs; ! 706: Pbadmsg("differing numbers of arguments",p); ! 707: fprintf(stderr, "here %d, previously %d\n", ! 708: i, j); ! 709: return; ! 710: } ! 711: for(aty = at->atypes; t < te; t++, aty++) { ! 712: if (*t == aty->type) ! 713: continue; ! 714: j = aty->type; ! 715: k = *t; ! 716: if (k >= 300 || k == j) ! 717: continue; ! 718: if (j >= 300) { ! 719: if (k >= 200) { ! 720: if (k == TYUNKNOWN + 200) ! 721: continue; ! 722: if (j % 100 != k - 200 ! 723: && k != TYSUBR + 200 ! 724: && j != TYUNKNOWN + 300 ! 725: && !type_fixup(at,aty,k)) ! 726: goto badtypes; ! 727: } ! 728: else if (j % 100 % TYSUBR != k % TYSUBR ! 729: && !type_fixup(at,aty,k)) ! 730: goto badtypes; ! 731: } ! 732: else if (k < 200 || j < 200) ! 733: goto badtypes; ! 734: else if (k == TYUNKNOWN+200) ! 735: continue; ! 736: else if (j != TYUNKNOWN+200) ! 737: { ! 738: badtypes: ! 739: Pbadmsg("differing calling sequences",p); ! 740: i = t - tfirst + 1; ! 741: fprintf(stderr, ! 742: "arg %d: here %s, prevously %s\n", ! 743: i, Argtype(k,buf1), Argtype(j,buf2)); ! 744: return; ! 745: } ! 746: /* We've subsequently learned the right type, ! 747: as in the call on zoo below... ! 748: ! 749: subroutine foo(x, zap) ! 750: external zap ! 751: call goo(zap) ! 752: x = zap(3) ! 753: call zoo(zap) ! 754: end ! 755: */ ! 756: aty->type = k; ! 757: at->changes = 1; ! 758: } ! 759: } ! 760: ! 761: static void ! 762: newarg(ftype, p) ! 763: int ftype; ! 764: Extsym *p; ! 765: { ! 766: Argtypes *at; ! 767: register Atype *aty; ! 768: register int *t, *te; ! 769: int i, k; ! 770: ! 771: if (p->extstg == STGCOMMON) { ! 772: Pnotboth(p); ! 773: return; ! 774: } ! 775: p->extstg = STGEXT; ! 776: p->extype = ftype; ! 777: p->exproto = 1; ! 778: t = tfirst; ! 779: te = tnext; ! 780: i = te - t; ! 781: k = sizeof(Argtypes) + (i-1)*sizeof(Atype); ! 782: at = p->arginfo = (Argtypes *)gmem(k,1); ! 783: at->dnargs = at->nargs = i; ! 784: at->defined = at->changes = 0; ! 785: for(aty = at->atypes; t < te; aty++) { ! 786: aty->type = *t++; ! 787: aty->cp = 0; ! 788: } ! 789: } ! 790: ! 791: static int ! 792: Pfile(fname) ! 793: char *fname; ! 794: { ! 795: char *s; ! 796: int ftype, i; ! 797: FILE *pf; ! 798: Extsym *p; ! 799: ! 800: for(s = fname; *s; s++); ! 801: if (s - fname < 2 ! 802: || s[-2] != '.' ! 803: || (s[-1] != 'P' && s[-1] != 'p')) ! 804: return 0; ! 805: ! 806: if (!(pf = fopen(fname, textread))) { ! 807: fprintf(stderr, "can't open %s\n", fname); ! 808: exit(2); ! 809: } ! 810: Pfname = fname; ! 811: Plineno = 1; ! 812: if (!Pct[' ']) { ! 813: for(s = " \t\n\r\v\f"; *s; s++) ! 814: Pct[*s] = P_space; ! 815: for(s = "*,();"; *s; s++) ! 816: Pct[*s] = P_delim; ! 817: for(i = '0'; i <= '9'; i++) ! 818: Pct[i] = P_anum; ! 819: for(s = "abcdefghijklmnopqrstuvwxyz"; i = *s; s++) ! 820: Pct[i] = Pct[i+'A'-'a'] = P_anum; ! 821: Pct['_'] = P_anum; ! 822: Pct['/'] = P_slash; ! 823: } ! 824: ! 825: for(;;) { ! 826: if (!(i = Ptoken(pf,1))) ! 827: break; ! 828: if (i != P_anum ! 829: || !strcmp(Ptok, "extern") && (i = Ptoken(pf,0)) != P_anum) ! 830: badchar(i); ! 831: ftype = Pftype(); ! 832: getname: ! 833: if ((i = Ptoken(pf,0)) != P_anum) ! 834: badchar(i); ! 835: p = mkext(trimunder(), Ptok); ! 836: ! 837: if ((i = Ptoken(pf,0)) != '(') ! 838: badchar(i); ! 839: tnext = tfirst; ! 840: while(i = Ptype(pf)) { ! 841: if (tnext >= tlast) ! 842: trealloc(); ! 843: *tnext++ = i; ! 844: } ! 845: if (p->arginfo) { ! 846: argverify(ftype, p); ! 847: if (p->arginfo->nargs < 0) ! 848: newarg(ftype, p); ! 849: } ! 850: else ! 851: newarg(ftype, p); ! 852: p->arginfo->defined = 1; ! 853: i = Ptoken(pf,0); ! 854: switch(i) { ! 855: case ';': ! 856: break; ! 857: case ',': ! 858: goto getname; ! 859: default: ! 860: wanted(i, "\";\" or \",\""); ! 861: } ! 862: } ! 863: fclose(pf); ! 864: return 1; ! 865: } ! 866: ! 867: void ! 868: read_Pfiles(ffiles) ! 869: char **ffiles; ! 870: { ! 871: char **f1files, **f1files0, *s; ! 872: int k; ! 873: register Extsym *e, *ee; ! 874: register Argtypes *at; ! 875: extern int retcode; ! 876: ! 877: f1files0 = f1files = ffiles; ! 878: while(s = *ffiles++) ! 879: if (!Pfile(s)) ! 880: *f1files++ = s; ! 881: if (Pbad) ! 882: retcode = 8; ! 883: if (tfirst) { ! 884: free((char *)tfirst); ! 885: /* following should be unnecessary, as we won't be back here */ ! 886: tfirst = tnext = tlast = 0; ! 887: tmax = 0; ! 888: } ! 889: *f1files = 0; ! 890: if (f1files == f1files0) ! 891: f1files[1] = 0; ! 892: ! 893: k = 0; ! 894: ee = nextext; ! 895: for (e = extsymtab; e < ee; e++) ! 896: if (e->extstg == STGEXT ! 897: && (at = e->arginfo)) { ! 898: if (at->nargs < 0 || at->changes) ! 899: k++; ! 900: at->changes = 2; ! 901: } ! 902: if (k) { ! 903: fprintf(diagfile, ! 904: "%d prototype%s updated while reading prototypes.\n", k, ! 905: k > 1 ? "s" : ""); ! 906: } ! 907: fflush(diagfile); ! 908: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.