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