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