00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024 #include "defs.h"
00025
00026 static char Ptok[128], Pct[Table_size];
00027 static char *Pfname;
00028 static long Plineno;
00029 static int Pbad;
00030 static int *tfirst, *tlast, *tnext, tmax;
00031
00032 #define P_space 1
00033 #define P_anum 2
00034 #define P_delim 3
00035 #define P_slash 4
00036
00037 #define TGULP 100
00038
00039 static void
00040 trealloc(Void)
00041 {
00042 int k = tmax;
00043 tfirst = (int *)realloc((char *)tfirst,
00044 (tmax += TGULP)*sizeof(int));
00045 if (!tfirst) {
00046 fprintf(stderr,
00047 "Pfile: realloc failure!\n");
00048 exit(2);
00049 }
00050 tlast = tfirst + tmax;
00051 tnext = tfirst + k;
00052 }
00053
00054 static void
00055 #ifdef KR_headers
00056 badchar(c)
00057 int c;
00058 #else
00059 badchar(int c)
00060 #endif
00061 {
00062 fprintf(stderr,
00063 "unexpected character 0x%.2x = '%c' on line %ld of %s\n",
00064 c, c, Plineno, Pfname);
00065 exit(2);
00066 }
00067
00068 static void
00069 bad_type(Void)
00070 {
00071 fprintf(stderr,
00072 "unexpected type \"%s\" on line %ld of %s\n",
00073 Ptok, Plineno, Pfname);
00074 exit(2);
00075 }
00076
00077 static void
00078 #ifdef KR_headers
00079 badflag(tname, option)
00080 char *tname;
00081 char *option;
00082 #else
00083 badflag(char *tname, char *option)
00084 #endif
00085 {
00086 fprintf(stderr, "%s type from `f2c -%s` on line %ld of %s\n",
00087 tname, option, Plineno, Pfname);
00088 Pbad++;
00089 }
00090
00091 static void
00092 #ifdef KR_headers
00093 detected(msg)
00094 char *msg;
00095 #else
00096 detected(char *msg)
00097 #endif
00098 {
00099 fprintf(stderr,
00100 "%sdetected on line %ld of %s\n", msg, Plineno, Pfname);
00101 Pbad++;
00102 }
00103
00104 #if 0
00105 static void
00106 #ifdef KR_headers
00107 checklogical(k)
00108 int k;
00109 #else
00110 checklogical(int k)
00111 #endif
00112 {
00113 static int lastmsg = 0;
00114 static int seen[2] = {0,0};
00115
00116 seen[k] = 1;
00117 if (seen[1-k]) {
00118 if (lastmsg < 3) {
00119 lastmsg = 3;
00120 detected(
00121 "Illegal combination of LOGICAL types -- mixing -I4 with -I2 or -i2\n\t");
00122 }
00123 return;
00124 }
00125 if (k) {
00126 if (tylogical == TYLONG || lastmsg >= 2)
00127 return;
00128 if (!lastmsg) {
00129 lastmsg = 2;
00130 badflag("LOGICAL", "I4");
00131 }
00132 }
00133 else {
00134 if (tylogical == TYSHORT || lastmsg & 1)
00135 return;
00136 if (!lastmsg) {
00137 lastmsg = 1;
00138 badflag("LOGICAL", "i2` or `f2c -I2");
00139 }
00140 }
00141 }
00142 #else
00143 #define checklogical(n)
00144 #endif
00145
00146 static void
00147 #ifdef KR_headers
00148 checkreal(k)
00149 int k;
00150 #else
00151 checkreal(int k)
00152 #endif
00153 {
00154 static int warned = 0;
00155 static int seen[2] = {0,0};
00156
00157 seen[k] = 1;
00158 if (seen[1-k]) {
00159 if (warned < 2)
00160 detected("Illegal mixture of -R and -!R ");
00161 warned = 2;
00162 return;
00163 }
00164 if (k == forcedouble || warned)
00165 return;
00166 warned = 1;
00167 badflag("REAL return", k ? "!R" : "R");
00168 }
00169
00170 static void
00171 #ifdef KR_headers
00172 Pnotboth(e)
00173 Extsym *e;
00174 #else
00175 Pnotboth(Extsym *e)
00176 #endif
00177 {
00178 if (e->curno)
00179 return;
00180 Pbad++;
00181 e->curno = 1;
00182 fprintf(stderr,
00183 "%s cannot be both a procedure and a common block (line %ld of %s)\n",
00184 e->fextname, Plineno, Pfname);
00185 }
00186
00187 static int
00188 #ifdef KR_headers
00189 numread(pf, n)
00190 register FILE *pf;
00191 int *n;
00192 #else
00193 numread(register FILE *pf, int *n)
00194 #endif
00195 {
00196 register int c, k;
00197
00198 if ((c = getc(pf)) < '0' || c > '9')
00199 return c;
00200 k = c - '0';
00201 for(;;) {
00202 if ((c = getc(pf)) == ' ') {
00203 *n = k;
00204 return c;
00205 }
00206 if (c < '0' || c > '9')
00207 break;
00208 k = 10*k + c - '0';
00209 }
00210 return c;
00211 }
00212
00213 static void argverify Argdcl((int, Extsym*));
00214 static void Pbadret Argdcl((int ftype, Extsym *p));
00215
00216 static int
00217 #ifdef KR_headers
00218 readref(pf, e, ftype)
00219 register FILE *pf;
00220 Extsym *e;
00221 int ftype;
00222 #else
00223 readref(register FILE *pf, Extsym *e, int ftype)
00224 #endif
00225 {
00226 register int c, *t;
00227 int i, nargs, type;
00228 Argtypes *at;
00229 Atype *a, *ae;
00230
00231 if (ftype > TYSUBR)
00232 return 0;
00233 if ((c = numread(pf, &nargs)) != ' ') {
00234 if (c != ':')
00235 return c == EOF;
00236
00237 if (e->extstg == STGUNKNOWN) {
00238 at = 0;
00239 goto justsym;
00240 }
00241 if (e->extstg == STGEXT) {
00242 if (e->extype != ftype)
00243 Pbadret(ftype, e);
00244 }
00245 else
00246 Pnotboth(e);
00247 return 0;
00248 }
00249
00250 tnext = tfirst;
00251 for(i = 0; i < nargs; i++) {
00252 if ((c = numread(pf, &type)) != ' '
00253 || type >= 500
00254 || type != TYFTNLEN + 100 && type % 100 > TYSUBR)
00255 return c == EOF;
00256 if (tnext >= tlast)
00257 trealloc();
00258 *tnext++ = type;
00259 }
00260
00261 if (e->extstg == STGUNKNOWN) {
00262 save_at:
00263 at = (Argtypes *)
00264 gmem(sizeof(Argtypes) + (nargs-1)*sizeof(Atype), 1);
00265 at->dnargs = at->nargs = nargs;
00266 at->changes = 0;
00267 t = tfirst;
00268 a = at->atypes;
00269 for(ae = a + nargs; a < ae; a++) {
00270 a->type = *t++;
00271 a->cp = 0;
00272 }
00273 justsym:
00274 e->extstg = STGEXT;
00275 e->extype = ftype;
00276 e->arginfo = at;
00277 }
00278 else if (e->extstg != STGEXT) {
00279 Pnotboth(e);
00280 }
00281 else if (!e->arginfo) {
00282 if (e->extype != ftype)
00283 Pbadret(ftype, e);
00284 else
00285 goto save_at;
00286 }
00287 else
00288 argverify(ftype, e);
00289 return 0;
00290 }
00291
00292 static int
00293 #ifdef KR_headers
00294 comlen(pf)
00295 register FILE *pf;
00296 #else
00297 comlen(register FILE *pf)
00298 #endif
00299 {
00300 register int c;
00301 register char *s, *se;
00302 char buf[128], cbuf[128];
00303 int refread;
00304 long L;
00305 Extsym *e;
00306
00307 if ((c = getc(pf)) == EOF)
00308 return 1;
00309 if (c == ' ') {
00310 refread = 0;
00311 s = "comlen ";
00312 }
00313 else if (c == ':') {
00314 refread = 1;
00315 s = "ref: ";
00316 }
00317 else {
00318 ret0:
00319 if (c == '*')
00320 ungetc(c,pf);
00321 return 0;
00322 }
00323 while(*s) {
00324 if ((c = getc(pf)) == EOF)
00325 return 1;
00326 if (c != *s++)
00327 goto ret0;
00328 }
00329 s = buf;
00330 se = buf + sizeof(buf) - 1;
00331 for(;;) {
00332 if ((c = getc(pf)) == EOF)
00333 return 1;
00334 if (c == ' ')
00335 break;
00336 if (s >= se || Pct[c] != P_anum)
00337 goto ret0;
00338 *s++ = c;
00339 }
00340 *s-- = 0;
00341 if (s <= buf || *s != '_')
00342 return 0;
00343 strcpy(cbuf,buf);
00344 *s-- = 0;
00345 if (*s == '_') {
00346 *s-- = 0;
00347 if (s <= buf)
00348 return 0;
00349 }
00350 for(L = 0;;) {
00351 if ((c = getc(pf)) == EOF)
00352 return 1;
00353 if (c == ' ')
00354 break;
00355 if (c < '0' && c > '9')
00356 goto ret0;
00357 L = 10*L + c - '0';
00358 }
00359 if (!L && !refread)
00360 return 0;
00361 e = mkext1(buf, cbuf);
00362 if (refread)
00363 return readref(pf, e, (int)L);
00364 if (e->extstg == STGUNKNOWN) {
00365 e->extstg = STGCOMMON;
00366 e->maxleng = L;
00367 }
00368 else if (e->extstg != STGCOMMON)
00369 Pnotboth(e);
00370 else if (e->maxleng != L) {
00371 fprintf(stderr,
00372 "incompatible lengths for common block %s (line %ld of %s)\n",
00373 buf, Plineno, Pfname);
00374 if (e->maxleng < L)
00375 e->maxleng = L;
00376 }
00377 return 0;
00378 }
00379
00380 static int
00381 #ifdef KR_headers
00382 Ptoken(pf, canend)
00383 FILE *pf;
00384 int canend;
00385 #else
00386 Ptoken(FILE *pf, int canend)
00387 #endif
00388 {
00389 register int c;
00390 register char *s, *se;
00391
00392 top:
00393 for(;;) {
00394 c = getc(pf);
00395 if (c == EOF) {
00396 if (canend)
00397 return 0;
00398 goto badeof;
00399 }
00400 if (Pct[c] != P_space)
00401 break;
00402 if (c == '\n')
00403 Plineno++;
00404 }
00405 switch(Pct[c]) {
00406 case P_anum:
00407 if (c == '_')
00408 badchar(c);
00409 s = Ptok;
00410 se = s + sizeof(Ptok) - 1;
00411 do {
00412 if (s < se)
00413 *s++ = c;
00414 if ((c = getc(pf)) == EOF) {
00415 badeof:
00416 fprintf(stderr,
00417 "unexpected end of file in %s\n",
00418 Pfname);
00419 exit(2);
00420 }
00421 }
00422 while(Pct[c] == P_anum);
00423 ungetc(c,pf);
00424 *s = 0;
00425 return P_anum;
00426
00427 case P_delim:
00428 return c;
00429
00430 case P_slash:
00431 if ((c = getc(pf)) != '*') {
00432 if (c == EOF)
00433 goto badeof;
00434 badchar('/');
00435 }
00436 if (canend && comlen(pf))
00437 goto badeof;
00438 for(;;) {
00439 while((c = getc(pf)) != '*') {
00440 if (c == EOF)
00441 goto badeof;
00442 if (c == '\n')
00443 Plineno++;
00444 }
00445 slashseek:
00446 switch(getc(pf)) {
00447 case '/':
00448 goto top;
00449 case EOF:
00450 goto badeof;
00451 case '*':
00452 goto slashseek;
00453 }
00454 }
00455 default:
00456 badchar(c);
00457 }
00458
00459 return 0;
00460 }
00461
00462 static int
00463 Pftype(Void)
00464 {
00465 switch(Ptok[0]) {
00466 case 'C':
00467 if (!strcmp(Ptok+1, "_f"))
00468 return TYCOMPLEX;
00469 break;
00470 case 'E':
00471 if (!strcmp(Ptok+1, "_f")) {
00472
00473 checkreal(1);
00474 return TYREAL;
00475 }
00476 break;
00477 case 'H':
00478 if (!strcmp(Ptok+1, "_f"))
00479 return TYCHAR;
00480 break;
00481 case 'Z':
00482 if (!strcmp(Ptok+1, "_f"))
00483 return TYDCOMPLEX;
00484 break;
00485 case 'd':
00486 if (!strcmp(Ptok+1, "oublereal"))
00487 return TYDREAL;
00488 break;
00489 case 'i':
00490 if (!strcmp(Ptok+1, "nt"))
00491 return TYSUBR;
00492 if (!strcmp(Ptok+1, "nteger"))
00493 return TYLONG;
00494 if (!strcmp(Ptok+1, "nteger1"))
00495 return TYINT1;
00496 break;
00497 case 'l':
00498 if (!strcmp(Ptok+1, "ogical")) {
00499 checklogical(1);
00500 return TYLOGICAL;
00501 }
00502 if (!strcmp(Ptok+1, "ogical1"))
00503 return TYLOGICAL1;
00504 #ifdef TYQUAD
00505 if (!strcmp(Ptok+1, "ongint"))
00506 return TYQUAD;
00507 #endif
00508 break;
00509 case 'r':
00510 if (!strcmp(Ptok+1, "eal")) {
00511 checkreal(0);
00512 return TYREAL;
00513 }
00514 break;
00515 case 's':
00516 if (!strcmp(Ptok+1, "hortint"))
00517 return TYSHORT;
00518 if (!strcmp(Ptok+1, "hortlogical")) {
00519 checklogical(0);
00520 return TYLOGICAL2;
00521 }
00522 break;
00523 }
00524 bad_type();
00525
00526 return 0;
00527 }
00528
00529 static void
00530 #ifdef KR_headers
00531 wanted(i, what)
00532 int i;
00533 char *what;
00534 #else
00535 wanted(int i, char *what)
00536 #endif
00537 {
00538 if (i != P_anum) {
00539 Ptok[0] = i;
00540 Ptok[1] = 0;
00541 }
00542 fprintf(stderr,"Error: expected %s, not \"%s\" (line %ld of %s)\n",
00543 what, Ptok, Plineno, Pfname);
00544 exit(2);
00545 }
00546
00547 static int
00548 #ifdef KR_headers
00549 Ptype(pf)
00550 FILE *pf;
00551 #else
00552 Ptype(FILE *pf)
00553 #endif
00554 {
00555 int i, rv;
00556
00557 i = Ptoken(pf,0);
00558 if (i == ')')
00559 return 0;
00560 if (i != P_anum)
00561 badchar(i);
00562
00563 rv = 0;
00564 switch(Ptok[0]) {
00565 case 'C':
00566 if (!strcmp(Ptok+1, "_fp"))
00567 rv = TYCOMPLEX+200;
00568 break;
00569 case 'D':
00570 if (!strcmp(Ptok+1, "_fp"))
00571 rv = TYDREAL+200;
00572 break;
00573 case 'E':
00574 case 'R':
00575 if (!strcmp(Ptok+1, "_fp"))
00576 rv = TYREAL+200;
00577 break;
00578 case 'H':
00579 if (!strcmp(Ptok+1, "_fp"))
00580 rv = TYCHAR+200;
00581 break;
00582 case 'I':
00583 if (!strcmp(Ptok+1, "_fp"))
00584 rv = TYLONG+200;
00585 else if (!strcmp(Ptok+1, "1_fp"))
00586 rv = TYINT1+200;
00587 #ifdef TYQUAD
00588 else if (!strcmp(Ptok+1, "8_fp"))
00589 rv = TYQUAD+200;
00590 #endif
00591 break;
00592 case 'J':
00593 if (!strcmp(Ptok+1, "_fp"))
00594 rv = TYSHORT+200;
00595 break;
00596 case 'K':
00597 checklogical(0);
00598 goto Logical;
00599 case 'L':
00600 checklogical(1);
00601 Logical:
00602 if (!strcmp(Ptok+1, "_fp"))
00603 rv = TYLOGICAL+200;
00604 else if (!strcmp(Ptok+1, "1_fp"))
00605 rv = TYLOGICAL1+200;
00606 else if (!strcmp(Ptok+1, "2_fp"))
00607 rv = TYLOGICAL2+200;
00608 break;
00609 case 'S':
00610 if (!strcmp(Ptok+1, "_fp"))
00611 rv = TYSUBR+200;
00612 break;
00613 case 'U':
00614 if (!strcmp(Ptok+1, "_fp"))
00615 rv = TYUNKNOWN+300;
00616 break;
00617 case 'Z':
00618 if (!strcmp(Ptok+1, "_fp"))
00619 rv = TYDCOMPLEX+200;
00620 break;
00621 case 'c':
00622 if (!strcmp(Ptok+1, "har"))
00623 rv = TYCHAR;
00624 else if (!strcmp(Ptok+1, "omplex"))
00625 rv = TYCOMPLEX;
00626 break;
00627 case 'd':
00628 if (!strcmp(Ptok+1, "oublereal"))
00629 rv = TYDREAL;
00630 else if (!strcmp(Ptok+1, "oublecomplex"))
00631 rv = TYDCOMPLEX;
00632 break;
00633 case 'f':
00634 if (!strcmp(Ptok+1, "tnlen"))
00635 rv = TYFTNLEN+100;
00636 break;
00637 case 'i':
00638 if (!strncmp(Ptok+1, "nteger", 6)) {
00639 if (!Ptok[7])
00640 rv = TYLONG;
00641 else if (Ptok[7] == '1' && !Ptok[8])
00642 rv = TYINT1;
00643 }
00644 break;
00645 case 'l':
00646 if (!strncmp(Ptok+1, "ogical", 6)) {
00647 if (!Ptok[7]) {
00648 checklogical(1);
00649 rv = TYLOGICAL;
00650 }
00651 else if (Ptok[7] == '1' && !Ptok[8])
00652 rv = TYLOGICAL1;
00653 }
00654 #ifdef TYQUAD
00655 else if (!strcmp(Ptok+1,"ongint"))
00656 rv = TYQUAD;
00657 #endif
00658 break;
00659 case 'r':
00660 if (!strcmp(Ptok+1, "eal"))
00661 rv = TYREAL;
00662 break;
00663 case 's':
00664 if (!strcmp(Ptok+1, "hortint"))
00665 rv = TYSHORT;
00666 else if (!strcmp(Ptok+1, "hortlogical")) {
00667 checklogical(0);
00668 rv = TYLOGICAL2;
00669 }
00670 break;
00671 case 'v':
00672 if (tnext == tfirst && !strcmp(Ptok+1, "oid")) {
00673 if ((i = Ptoken(pf,0)) != ')')
00674 wanted(i, "\")\"");
00675 return 0;
00676 }
00677 }
00678 if (!rv)
00679 bad_type();
00680 if (rv < 100 && (i = Ptoken(pf,0)) != '*')
00681 wanted(i, "\"*\"");
00682 if ((i = Ptoken(pf,0)) == P_anum)
00683 i = Ptoken(pf,0);
00684 switch(i) {
00685 case ')':
00686 ungetc(i,pf);
00687 break;
00688 case ',':
00689 break;
00690 default:
00691 wanted(i, "\",\" or \")\"");
00692 }
00693 return rv;
00694 }
00695
00696 static char *
00697 trimunder(Void)
00698 {
00699 register char *s;
00700 register int n;
00701 static char buf[128];
00702
00703 s = Ptok + strlen(Ptok) - 1;
00704 if (*s != '_') {
00705 fprintf(stderr,
00706 "warning: %s does not end in _ (line %ld of %s)\n",
00707 Ptok, Plineno, Pfname);
00708 return Ptok;
00709 }
00710 if (s[-1] == '_')
00711 s--;
00712 strncpy(buf, Ptok, n = s - Ptok);
00713 buf[n] = 0;
00714 return buf;
00715 }
00716
00717 static void
00718 #ifdef KR_headers
00719 Pbadmsg(msg, p)
00720 char *msg;
00721 Extsym *p;
00722 #else
00723 Pbadmsg(char *msg, Extsym *p)
00724 #endif
00725 {
00726 Pbad++;
00727 fprintf(stderr, "%s for %s (line %ld of %s):\n\t", msg,
00728 p->fextname, Plineno, Pfname);
00729 p->arginfo->nargs = -1;
00730 }
00731
00732 static void
00733 #ifdef KR_headers
00734 Pbadret(ftype, p)
00735 int ftype;
00736 Extsym *p;
00737 #else
00738 Pbadret(int ftype, Extsym *p)
00739 #endif
00740 {
00741 char buf1[32], buf2[32];
00742
00743 Pbadmsg("inconsistent types",p);
00744 fprintf(stderr, "here %s, previously %s\n",
00745 Argtype(ftype+200,buf1),
00746 Argtype(p->extype+200,buf2));
00747 }
00748
00749 static void
00750 #ifdef KR_headers
00751 argverify(ftype, p)
00752 int ftype;
00753 Extsym *p;
00754 #else
00755 argverify(int ftype, Extsym *p)
00756 #endif
00757 {
00758 Argtypes *at;
00759 register Atype *aty;
00760 int i, j, k;
00761 register int *t, *te;
00762 char buf1[32], buf2[32];
00763
00764 at = p->arginfo;
00765 if (at->nargs < 0)
00766 return;
00767 if (p->extype != ftype) {
00768 Pbadret(ftype, p);
00769 return;
00770 }
00771 t = tfirst;
00772 te = tnext;
00773 i = te - t;
00774 if (at->nargs != i) {
00775 j = at->nargs;
00776 Pbadmsg("differing numbers of arguments",p);
00777 fprintf(stderr, "here %d, previously %d\n",
00778 i, j);
00779 return;
00780 }
00781 for(aty = at->atypes; t < te; t++, aty++) {
00782 if (*t == aty->type)
00783 continue;
00784 j = aty->type;
00785 k = *t;
00786 if (k >= 300 || k == j)
00787 continue;
00788 if (j >= 300) {
00789 if (k >= 200) {
00790 if (k == TYUNKNOWN + 200)
00791 continue;
00792 if (j % 100 != k - 200
00793 && k != TYSUBR + 200
00794 && j != TYUNKNOWN + 300
00795 && !type_fixup(at,aty,k))
00796 goto badtypes;
00797 }
00798 else if (j % 100 % TYSUBR != k % TYSUBR
00799 && !type_fixup(at,aty,k))
00800 goto badtypes;
00801 }
00802 else if (k < 200 || j < 200)
00803 goto badtypes;
00804 else if (k == TYUNKNOWN+200)
00805 continue;
00806 else if (j != TYUNKNOWN+200)
00807 {
00808 badtypes:
00809 Pbadmsg("differing calling sequences",p);
00810 i = t - tfirst + 1;
00811 fprintf(stderr,
00812 "arg %d: here %s, prevously %s\n",
00813 i, Argtype(k,buf1), Argtype(j,buf2));
00814 return;
00815 }
00816
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826 aty->type = k;
00827 at->changes = 1;
00828 }
00829 }
00830
00831 static void
00832 #ifdef KR_headers
00833 newarg(ftype, p)
00834 int ftype;
00835 Extsym *p;
00836 #else
00837 newarg(int ftype, Extsym *p)
00838 #endif
00839 {
00840 Argtypes *at;
00841 register Atype *aty;
00842 register int *t, *te;
00843 int i, k;
00844
00845 if (p->extstg == STGCOMMON) {
00846 Pnotboth(p);
00847 return;
00848 }
00849 p->extstg = STGEXT;
00850 p->extype = ftype;
00851 p->exproto = 1;
00852 t = tfirst;
00853 te = tnext;
00854 i = te - t;
00855 k = sizeof(Argtypes) + (i-1)*sizeof(Atype);
00856 at = p->arginfo = (Argtypes *)gmem(k,1);
00857 at->dnargs = at->nargs = i;
00858 at->defined = at->changes = 0;
00859 for(aty = at->atypes; t < te; aty++) {
00860 aty->type = *t++;
00861 aty->cp = 0;
00862 }
00863 }
00864
00865 static int
00866 #ifdef KR_headers
00867 Pfile(fname)
00868 char *fname;
00869 #else
00870 Pfile(char *fname)
00871 #endif
00872 {
00873 char *s;
00874 int ftype, i;
00875 FILE *pf;
00876 Extsym *p;
00877
00878 for(s = fname; *s; s++);
00879 if (s - fname < 2
00880 || s[-2] != '.'
00881 || (s[-1] != 'P' && s[-1] != 'p'))
00882 return 0;
00883
00884 if (!(pf = fopen(fname, textread))) {
00885 fprintf(stderr, "can't open %s\n", fname);
00886 exit(2);
00887 }
00888 Pfname = fname;
00889 Plineno = 1;
00890 if (!Pct[' ']) {
00891 for(s = " \t\n\r\v\f"; *s; s++)
00892 Pct[*s] = P_space;
00893 for(s = "*,();"; *s; s++)
00894 Pct[*s] = P_delim;
00895 for(i = '0'; i <= '9'; i++)
00896 Pct[i] = P_anum;
00897 for(s = "abcdefghijklmnopqrstuvwxyz"; i = *s; s++)
00898 Pct[i] = Pct[i+'A'-'a'] = P_anum;
00899 Pct['_'] = P_anum;
00900 Pct['/'] = P_slash;
00901 }
00902
00903 for(;;) {
00904 if (!(i = Ptoken(pf,1)))
00905 break;
00906 if (i != P_anum
00907 || !strcmp(Ptok, "extern") && (i = Ptoken(pf,0)) != P_anum)
00908 badchar(i);
00909 ftype = Pftype();
00910 getname:
00911 if ((i = Ptoken(pf,0)) != P_anum)
00912 badchar(i);
00913 p = mkext1(trimunder(), Ptok);
00914
00915 if ((i = Ptoken(pf,0)) != '(')
00916 badchar(i);
00917 tnext = tfirst;
00918 while(i = Ptype(pf)) {
00919 if (tnext >= tlast)
00920 trealloc();
00921 *tnext++ = i;
00922 }
00923 if (p->arginfo) {
00924 argverify(ftype, p);
00925 if (p->arginfo->nargs < 0)
00926 newarg(ftype, p);
00927 }
00928 else
00929 newarg(ftype, p);
00930 p->arginfo->defined = 1;
00931 i = Ptoken(pf,0);
00932 switch(i) {
00933 case ';':
00934 break;
00935 case ',':
00936 goto getname;
00937 default:
00938 wanted(i, "\";\" or \",\"");
00939 }
00940 }
00941 fclose(pf);
00942 return 1;
00943 }
00944
00945 void
00946 #ifdef KR_headers
00947 read_Pfiles(ffiles)
00948 char **ffiles;
00949 #else
00950 read_Pfiles(char **ffiles)
00951 #endif
00952 {
00953 char **f1files, **f1files0, *s;
00954 int k;
00955 register Extsym *e, *ee;
00956 register Argtypes *at;
00957 extern int retcode;
00958
00959 f1files0 = f1files = ffiles;
00960 while(s = *ffiles++)
00961 if (!Pfile(s))
00962 *f1files++ = s;
00963 if (Pbad)
00964 retcode = 8;
00965 if (tfirst) {
00966 free((char *)tfirst);
00967
00968 tfirst = tnext = tlast = 0;
00969 tmax = 0;
00970 }
00971 *f1files = 0;
00972 if (f1files == f1files0)
00973 f1files[1] = 0;
00974
00975 k = 0;
00976 ee = nextext;
00977 for (e = extsymtab; e < ee; e++)
00978 if (e->extstg == STGEXT
00979 && (at = e->arginfo)) {
00980 if (at->nargs < 0 || at->changes)
00981 k++;
00982 at->changes = 2;
00983 }
00984 if (k) {
00985 fprintf(diagfile,
00986 "%d prototype%s updated while reading prototypes.\n", k,
00987 k > 1 ? "s" : "");
00988 }
00989 fflush(diagfile);
00990 }
