lang/fortran/comp/pread.c

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