install with -s
[unix-history] / usr / src / usr.bin / ctags / ctags.c
CommitLineData
c30ca4f4
KB
1/*
2 * Copyright (c) 1980 Regents of the University of California.
3 * All rights reserved. The Berkeley software License Agreement
4 * specifies the terms and conditions for redistribution.
5 */
6
7#ifndef lint
8char copyright[] =
9"@(#) Copyright (c) 1980 Regents of the University of California.\n\
10 All rights reserved.\n";
11#endif not lint
12
13#ifndef lint
14static char sccsid[] = "@(#)ctags.c 5.1 (Berkeley) 5/31/85";
15#endif not lint
2e314d68 16
f5c61c07
KB
17#include <stdio.h>
18#include <ctype.h>
16bc359f
KB
19
20/*
9927b527 21 * ctags: create a tags file
16bc359f
KB
22 */
23
24#define reg register
c30ca4f4 25#define bool char
16bc359f
KB
26
27#define TRUE (1)
28#define FALSE (0)
29
30#define iswhite(arg) (_wht[arg]) /* T if char is white */
31#define begtoken(arg) (_btk[arg]) /* T if char can start token */
32#define intoken(arg) (_itk[arg]) /* T if char can be in token */
33#define endtoken(arg) (_etk[arg]) /* T if char ends tokens */
34#define isgood(arg) (_gd[arg]) /* T if char can be after ')' */
35
36#define max(I1,I2) (I1 > I2 ? I1 : I2)
37
38struct nd_st { /* sorting structure */
2e314d68 39 char *entry; /* function or type name */
16bc359f 40 char *file; /* file name */
c30ca4f4 41 bool f; /* use pattern or line no */
f5c61c07 42 int lno; /* for -x option */
16bc359f 43 char *pat; /* search pattern */
c30ca4f4 44 bool been_warned; /* set if noticed dup */
16bc359f
KB
45 struct nd_st *left,*right; /* left and right sons */
46};
47
48long ftell();
16bc359f
KB
49typedef struct nd_st NODE;
50
c30ca4f4
KB
51bool number, /* T if on line starting with # */
52 term = FALSE, /* T if print on terminal */
53 makefile= TRUE, /* T if to creat "tags" file */
16bc359f
KB
54 gotone, /* found a func already on line */
55 /* boolean "func" (see init) */
56 _wht[0177],_etk[0177],_itk[0177],_btk[0177],_gd[0177];
57
2e314d68
KB
58 /* typedefs are recognized using a simple finite automata,
59 * tydef is its state variable.
60 */
61typedef enum {none, begin, middle, end } TYST;
62
63TYST tydef = none;
64
65char searchar = '/'; /* use /.../ searches */
16bc359f
KB
66
67int lineno; /* line number of current line */
f5c61c07 68char line[4*BUFSIZ], /* current input line */
16bc359f
KB
69 *curfile, /* current input file name */
70 *outfile= "tags", /* output file */
71 *white = " \f\t\n", /* white chars */
72 *endtk = " \t\n\"'#()[]{}=-+%*/&|^~!<>;,.:?",
73 /* token ending chars */
74 *begtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz",
75 /* token starting chars */
2e314d68
KB
76 *intk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz0123456789",
77 /* valid in-token chars */
16bc359f
KB
78 *notgd = ",;"; /* non-valid after-function chars */
79
80int file_num; /* current file number */
81int aflag; /* -a: append to tags */
2e314d68 82int tflag; /* -t: create tags for typedefs */
16bc359f
KB
83int uflag; /* -u: update tags */
84int wflag; /* -w: suppress warnings */
9927b527 85int vflag; /* -v: create vgrind style index output */
f5c61c07
KB
86int xflag; /* -x: create cxref style output */
87
88char lbuf[BUFSIZ];
16bc359f
KB
89
90FILE *inf, /* ioptr for current input file */
91 *outf; /* ioptr for tags file */
92
93long lineftell; /* ftell after getc( inf ) == '\n' */
94
95NODE *head; /* the head of the sorted binary tree */
96
f5c61c07 97char *savestr();
c30ca4f4
KB
98char *rindex(), *index();
99char *toss_comment();
100
16bc359f
KB
101main(ac,av)
102int ac;
103char *av[];
104{
105 char cmd[100];
106 int i;
107
108 while (ac > 1 && av[1][0] == '-') {
109 for (i=1; av[1][i]; i++) {
110 switch(av[1][i]) {
c30ca4f4
KB
111 case 'B':
112 searchar='?';
113 break;
114 case 'F':
115 searchar='/';
116 break;
117 case 'a':
118 aflag++;
119 break;
120 case 't':
121 tflag++;
122 break;
123 case 'u':
124 uflag++;
125 break;
126 case 'w':
127 wflag++;
128 break;
129 case 'v':
130 vflag++;
131 xflag++;
132 break;
133 case 'x':
134 xflag++;
135 break;
136 case 'f':
137 if (ac < 2)
16bc359f 138 goto usage;
c30ca4f4
KB
139 ac--, av++;
140 outfile = av[1];
141 goto next;
142 default:
143 goto usage;
16bc359f 144 }
c30ca4f4
KB
145 }
146 next:
16bc359f
KB
147 ac--; av++;
148 }
149
150 if (ac <= 1) {
c30ca4f4
KB
151usage:
152 printf("Usage: ctags [-BFatuwvx] [-f tagsfile] file ...\n");
16bc359f
KB
153 exit(1);
154 }
155
156 init(); /* set up boolean "functions" */
157 /*
158 * loop through files finding functions
159 */
160 for (file_num = 1; file_num < ac; file_num++)
2e314d68 161 find_entries(av[file_num]);
16bc359f 162
f5c61c07 163 if (xflag) {
2e314d68 164 put_entries(head);
f5c61c07
KB
165 exit(0);
166 }
16bc359f
KB
167 if (uflag) {
168 for (i=1; i<ac; i++) {
f5c61c07
KB
169 sprintf(cmd,
170 "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS",
171 outfile, av[i], outfile);
16bc359f
KB
172 system(cmd);
173 }
174 aflag++;
175 }
f5c61c07
KB
176 outf = fopen(outfile, aflag ? "a" : "w");
177 if (outf == NULL) {
16bc359f
KB
178 perror(outfile);
179 exit(1);
180 }
2e314d68 181 put_entries(head);
f5c61c07
KB
182 fclose(outf);
183 if (uflag) {
184 sprintf(cmd, "sort %s -o %s", outfile, outfile);
185 system(cmd);
186 }
16bc359f
KB
187 exit(0);
188}
189
190/*
f5c61c07 191 * This routine sets up the boolean psuedo-functions which work
16bc359f 192 * by seting boolean flags dependent upon the corresponding character
16bc359f
KB
193 * Every char which is NOT in that string is not a white char. Therefore,
194 * all of the array "_wht" is set to FALSE, and then the elements
195 * subscripted by the chars in "white" are set to TRUE. Thus "_wht"
196 * of a char is TRUE if it is the string "white", else FALSE.
16bc359f
KB
197 */
198init()
199{
200
201 reg char *sp;
202 reg int i;
203
204 for (i = 0; i < 0177; i++) {
205 _wht[i] = _etk[i] = _itk[i] = _btk[i] = FALSE;
206 _gd[i] = TRUE;
207 }
208 for (sp = white; *sp; sp++)
209 _wht[*sp] = TRUE;
210 for (sp = endtk; *sp; sp++)
211 _etk[*sp] = TRUE;
212 for (sp = intk; *sp; sp++)
213 _itk[*sp] = TRUE;
214 for (sp = begtk; *sp; sp++)
215 _btk[*sp] = TRUE;
216 for (sp = notgd; *sp; sp++)
217 _gd[*sp] = FALSE;
218}
219
220/*
f5c61c07 221 * This routine opens the specified file and calls the function
2e314d68 222 * which finds the function and type definitions.
16bc359f 223 */
2e314d68 224find_entries(file)
16bc359f
KB
225char *file;
226{
f5c61c07 227 char *cp;
16bc359f 228
c30ca4f4 229 if ((inf = fopen(file,"r")) == NULL) {
16bc359f
KB
230 perror(file);
231 return;
232 }
f5c61c07 233 curfile = savestr(file);
c30ca4f4 234 lineno = 0;
f5c61c07 235 cp = rindex(file, '.');
c30ca4f4
KB
236 /* .l implies lisp or lex source code */
237 if (cp && cp[1] == 'l' && cp[2] == '\0') {
238 if (index(";([", first_char()) != NULL) { /* lisp */
239 L_funcs(inf);
240 fclose(inf);
241 return;
242 }
243 else { /* lex */
244 /*
245 * throw away all the code before the second "%%"
246 */
247 toss_yysec();
248 getline();
249 pfnote("yylex", lineno, TRUE);
250 toss_yysec();
3e0cab55 251 C_entries();
c30ca4f4
KB
252 fclose(inf);
253 return;
f5c61c07 254 }
c30ca4f4
KB
255 }
256 /* .y implies a yacc file */
257 if (cp && cp[1] == 'y' && cp[2] == '\0') {
258 toss_yysec();
259 Y_entries();
3e0cab55 260 C_entries();
c30ca4f4
KB
261 fclose(inf);
262 return;
263 }
264 /* if not a .c or .h file, try fortran */
265 if (cp && (cp[1] != 'c' && cp[1] != 'h') && cp[2] == '\0') {
266 if (PF_funcs(inf) != 0) {
267 fclose(inf);
268 return;
269 }
270 rewind(inf); /* no fortran tags found, try C */
271 }
272 C_entries();
16bc359f
KB
273 fclose(inf);
274}
275
2e314d68 276pfnote(name, ln, f)
c30ca4f4
KB
277char *name;
278int ln;
279bool f; /* f == TRUE when function */
f5c61c07
KB
280{
281 register char *fp;
282 register NODE *np;
283 char nbuf[BUFSIZ];
284
285 if ((np = (NODE *) malloc(sizeof (NODE))) == NULL) {
2e314d68
KB
286 fprintf(stderr, "ctags: too many entries to sort\n");
287 put_entries(head);
f5c61c07
KB
288 free_tree(head);
289 head = np = (NODE *) malloc(sizeof (NODE));
290 }
291 if (xflag == 0 && !strcmp(name, "main")) {
292 fp = rindex(curfile, '/');
293 if (fp == 0)
294 fp = curfile;
295 else
296 fp++;
297 sprintf(nbuf, "M%s", fp);
298 fp = rindex(nbuf, '.');
299 if (fp && fp[2] == 0)
300 *fp = 0;
301 name = nbuf;
302 }
2e314d68 303 np->entry = savestr(name);
f5c61c07 304 np->file = curfile;
2e314d68 305 np->f = f;
f5c61c07
KB
306 np->lno = ln;
307 np->left = np->right = 0;
308 if (xflag == 0) {
309 lbuf[50] = 0;
310 strcat(lbuf, "$");
311 lbuf[50] = 0;
312 }
313 np->pat = savestr(lbuf);
314 if (head == NULL)
315 head = np;
316 else
317 add_node(np, head);
318}
319
16bc359f 320/*
2e314d68 321 * This routine finds functions and typedefs in C syntax and adds them
16bc359f
KB
322 * to the list.
323 */
2e314d68 324C_entries()
16bc359f 325{
f5c61c07
KB
326 register int c;
327 register char *token, *tp;
c30ca4f4 328 bool incomm, inquote, inchar, midtoken;
2e314d68 329 int level;
f5c61c07
KB
330 char *sp;
331 char tok[BUFSIZ];
16bc359f 332
f5c61c07
KB
333 number = gotone = midtoken = inquote = inchar = incomm = FALSE;
334 level = 0;
16bc359f 335 sp = tp = token = line;
c30ca4f4
KB
336 lineno++;
337 lineftell = ftell(inf);
f5c61c07 338 for (;;) {
c30ca4f4 339 *sp = c = getc(inf);
f5c61c07
KB
340 if (feof(inf))
341 break;
342 if (c == '\n')
343 lineno++;
c30ca4f4 344 else if (c == '\\') {
16bc359f 345 c = *++sp = getc(inf);
c30ca4f4 346 if (c == '\n')
16bc359f 347 c = ' ';
c30ca4f4
KB
348 }
349 else if (incomm) {
16bc359f 350 if (c == '*') {
f5c61c07 351 while ((*++sp=c=getc(inf)) == '*')
16bc359f 352 continue;
f5c61c07
KB
353 if (c == '\n')
354 lineno++;
16bc359f 355 if (c == '/')
f5c61c07 356 incomm = FALSE;
16bc359f 357 }
c30ca4f4
KB
358 }
359 else if (inquote) {
16bc359f
KB
360 /*
361 * Too dumb to know about \" not being magic, but
362 * they usually occur in pairs anyway.
363 */
f5c61c07 364 if (c == '"')
16bc359f
KB
365 inquote = FALSE;
366 continue;
c30ca4f4
KB
367 }
368 else if (inchar) {
f5c61c07 369 if (c == '\'')
16bc359f
KB
370 inchar = FALSE;
371 continue;
c30ca4f4
KB
372 }
373 else switch (c) {
374 case '"':
16bc359f 375 inquote = TRUE;
f5c61c07 376 continue;
c30ca4f4 377 case '\'':
16bc359f 378 inchar = TRUE;
f5c61c07 379 continue;
c30ca4f4 380 case '/':
16bc359f 381 if ((*++sp=c=getc(inf)) == '*')
f5c61c07 382 incomm = TRUE;
16bc359f 383 else
f5c61c07
KB
384 ungetc(*sp, inf);
385 continue;
c30ca4f4 386 case '#':
16bc359f 387 if (sp == line)
f5c61c07
KB
388 number = TRUE;
389 continue;
c30ca4f4 390 case '{':
2e314d68
KB
391 if (tydef == begin) {
392 tydef=middle;
393 }
f5c61c07
KB
394 level++;
395 continue;
c30ca4f4 396 case '}':
f5c61c07
KB
397 if (sp == line)
398 level = 0; /* reset */
16bc359f 399 else
f5c61c07 400 level--;
2e314d68
KB
401 if (!level && tydef==middle) {
402 tydef=end;
403 }
f5c61c07
KB
404 continue;
405 }
2e314d68 406 if (!level && !inquote && !incomm && gotone == FALSE) {
16bc359f
KB
407 if (midtoken) {
408 if (endtoken(c)) {
2e314d68 409 int f;
f5c61c07 410 int pfline = lineno;
c30ca4f4 411 if (start_entry(&sp,token,tp,&f)) {
16bc359f
KB
412 strncpy(tok,token,tp-token+1);
413 tok[tp-token+1] = 0;
f5c61c07 414 getline();
2e314d68
KB
415 pfnote(tok, pfline, f);
416 gotone = f; /* function */
16bc359f
KB
417 }
418 midtoken = FALSE;
419 token = sp;
c30ca4f4
KB
420 }
421 else if (intoken(c))
16bc359f 422 tp++;
c30ca4f4
KB
423 }
424 else if (begtoken(c)) {
16bc359f
KB
425 token = tp = sp;
426 midtoken = TRUE;
427 }
428 }
2e314d68
KB
429 if (c == ';' && tydef==end) /* clean with typedefs */
430 tydef=none;
16bc359f 431 sp++;
f5c61c07 432 if (c == '\n' || sp > &line[sizeof (line) - BUFSIZ]) {
16bc359f 433 tp = token = sp = line;
f5c61c07 434 lineftell = ftell(inf);
16bc359f 435 number = gotone = midtoken = inquote = inchar = FALSE;
16bc359f
KB
436 }
437 }
438}
439
440/*
2e314d68
KB
441 * This routine checks to see if the current token is
442 * at the start of a function, or corresponds to a typedef
443 * It updates the input line * so that the '(' will be
444 * in it when it returns.
16bc359f 445 */
c30ca4f4
KB
446start_entry(lp,token,tp,f)
447char **lp,*token,*tp;
2e314d68 448int *f;
16bc359f 449{
c30ca4f4
KB
450 reg char c,*sp,*tsp;
451 static bool found;
452 bool firsttok; /* T if have seen first token in ()'s */
16bc359f
KB
453 int bad;
454
2e314d68 455 *f = 1; /* a function */
16bc359f
KB
456 sp = *lp;
457 c = *sp;
458 bad = FALSE;
f5c61c07 459 if (!number) { /* space is not allowed in macro defs */
16bc359f
KB
460 while (iswhite(c)) {
461 *++sp = c = getc(inf);
f5c61c07
KB
462 if (c == '\n') {
463 lineno++;
464 if (sp > &line[sizeof (line) - BUFSIZ])
465 goto ret;
466 }
16bc359f
KB
467 }
468 /* the following tries to make it so that a #define a b(c) */
469 /* doesn't count as a define of b. */
c30ca4f4
KB
470 }
471 else {
2e314d68 472 if (!strncmp(token, "define", 6))
16bc359f
KB
473 found = 0;
474 else
475 found++;
476 if (found >= 2) {
477 gotone = TRUE;
478badone: bad = TRUE;
479 goto ret;
480 }
481 }
2e314d68
KB
482 /* check for the typedef cases */
483 if (tflag && !strncmp(token, "typedef", 7)) {
484 tydef=begin;
485 goto badone;
486 }
487 if (tydef==begin && (!strncmp(token, "struct", 6) ||
488 !strncmp(token, "union", 5) || !strncmp(token, "enum", 4))) {
489 goto badone;
490 }
491 if (tydef==begin) {
492 tydef=end;
493 goto badone;
494 }
495 if (tydef==end) {
496 *f = 0;
497 goto ret;
498 }
16bc359f
KB
499 if (c != '(')
500 goto badone;
501 firsttok = FALSE;
502 while ((*++sp=c=getc(inf)) != ')') {
f5c61c07
KB
503 if (c == '\n') {
504 lineno++;
505 if (sp > &line[sizeof (line) - BUFSIZ])
506 goto ret;
507 }
16bc359f
KB
508 /*
509 * This line used to confuse ctags:
510 * int (*oldhup)();
511 * This fixes it. A nonwhite char before the first
512 * token, other than a / (in case of a comment in there)
513 * makes this not a declaration.
514 */
c30ca4f4
KB
515 if (begtoken(c) || c=='/')
516 firsttok++;
517 else if (!iswhite(c) && !firsttok)
518 goto badone;
16bc359f 519 }
16bc359f 520 while (iswhite(*++sp=c=getc(inf)))
f5c61c07
KB
521 if (c == '\n') {
522 lineno++;
523 if (sp > &line[sizeof (line) - BUFSIZ])
524 break;
525 }
16bc359f
KB
526ret:
527 *lp = --sp;
f5c61c07
KB
528 if (c == '\n')
529 lineno--;
16bc359f 530 ungetc(c,inf);
2e314d68
KB
531 return !bad && (!*f || isgood(c));
532 /* hack for typedefs */
16bc359f
KB
533}
534
c30ca4f4
KB
535/*
536 * Y_entries:
537 * Find the yacc tags and put them in.
538 */
539Y_entries()
540{
541 register char *sp, *orig_sp;
542 register int brace;
543 register bool in_rule, toklen;
544 char tok[BUFSIZ];
545
546 brace = 0;
547 getline();
548 pfnote("yyparse", lineno, TRUE);
549 while (fgets(line, sizeof line, inf) != NULL)
550 for (sp = line; *sp; sp++)
551 switch (*sp) {
552 case '\n':
553 lineno++;
554 /* FALLTHROUGH */
555 case ' ':
556 case '\t':
557 case '\f':
558 case '\r':
559 break;
560 case '"':
561 do {
562 while (*++sp != '"')
563 continue;
564 } while (sp[-1] == '\\');
565 break;
566 case '\'':
567 do {
568 while (*++sp != '\'')
569 continue;
570 } while (sp[-1] == '\\');
571 break;
572 case '/':
573 if (*++sp == '*')
574 sp = toss_comment(sp);
575 else
576 --sp;
577 break;
578 case '{':
579 brace++;
580 break;
581 case '}':
582 brace--;
583 break;
584 case '%':
585 if (sp[1] == '%' && sp == line)
586 return;
587 break;
588 case '|':
589 case ';':
590 in_rule = FALSE;
591 break;
592 default:
593 if (brace == 0 && !in_rule && (isalpha(*sp) ||
594 *sp == '.' ||
595 *sp == '_')) {
596 orig_sp = sp;
597 ++sp;
598 while (isalnum(*sp) || *sp == '_' ||
599 *sp == '.')
600 sp++;
601 toklen = sp - orig_sp;
602 while (isspace(*sp))
603 sp++;
604 if (*sp == ':' || (*sp == '\0' &&
605 first_char() == ':'))
606 {
607 strncpy(tok, orig_sp, toklen);
608 tok[toklen] = '\0';
609 strcpy(lbuf, line);
610 lbuf[strlen(lbuf) - 1] = '\0';
611 pfnote(tok, lineno, TRUE);
612 in_rule = TRUE;
613 }
614 else
615 sp--;
616 }
617 break;
618 }
619}
620
621char *
622toss_comment(start)
623char *start;
624{
625 register char *sp;
626
627 /*
628 * first, see if the end-of-comment is on the same line
629 */
630 do {
631 while ((sp = index(start, '*')) != NULL)
632 if (sp[1] == '/')
633 return ++sp;
634 else
635 start = ++sp;
636 start = line;
637 lineno++;
638 } while (fgets(line, sizeof line, inf) != NULL);
639}
640
f5c61c07 641getline()
16bc359f 642{
f5c61c07
KB
643 long saveftell = ftell( inf );
644 register char *cp;
645
646 fseek( inf , lineftell , 0 );
647 fgets(lbuf, sizeof lbuf, inf);
648 cp = rindex(lbuf, '\n');
649 if (cp)
650 *cp = 0;
651 fseek(inf, saveftell, 0);
16bc359f
KB
652}
653
16bc359f
KB
654free_tree(node)
655NODE *node;
656{
657
658 while (node) {
659 free_tree(node->right);
660 cfree(node);
661 node = node->left;
662 }
663}
664
f5c61c07
KB
665add_node(node, cur_node)
666 NODE *node,*cur_node;
16bc359f 667{
f5c61c07 668 register int dif;
16bc359f 669
2e314d68 670 dif = strcmp(node->entry, cur_node->entry);
16bc359f
KB
671 if (dif == 0) {
672 if (node->file == cur_node->file) {
673 if (!wflag) {
2e314d68
KB
674fprintf(stderr,"Duplicate entry in file %s, line %d: %s\n",
675 node->file,lineno,node->entry);
f5c61c07 676fprintf(stderr,"Second entry ignored\n");
16bc359f
KB
677 }
678 return;
679 }
f5c61c07
KB
680 if (!cur_node->been_warned)
681 if (!wflag)
2e314d68
KB
682fprintf(stderr,"Duplicate entry in files %s and %s: %s (Warning only)\n",
683 node->file, cur_node->file, node->entry);
f5c61c07
KB
684 cur_node->been_warned = TRUE;
685 return;
c30ca4f4
KB
686 }
687
f5c61c07 688 if (dif < 0) {
16bc359f
KB
689 if (cur_node->left != NULL)
690 add_node(node,cur_node->left);
f5c61c07 691 else
16bc359f 692 cur_node->left = node;
f5c61c07
KB
693 return;
694 }
695 if (cur_node->right != NULL)
696 add_node(node,cur_node->right);
16bc359f 697 else
f5c61c07 698 cur_node->right = node;
16bc359f
KB
699}
700
2e314d68 701put_entries(node)
f5c61c07 702reg NODE *node;
16bc359f 703{
f5c61c07 704 reg char *sp;
16bc359f
KB
705
706 if (node == NULL)
707 return;
2e314d68
KB
708 put_entries(node->left);
709 if (xflag == 0)
710 if (node->f) { /* a function */
711 fprintf(outf, "%s\t%s\t%c^",
712 node->entry, node->file, searchar);
713 for (sp = node->pat; *sp; sp++)
714 if (*sp == '\\')
715 fprintf(outf, "\\\\");
716 else if (*sp == searchar)
717 fprintf(outf, "\\%c", searchar);
718 else
719 putc(*sp, outf);
720 fprintf(outf, "%c\n", searchar);
c30ca4f4
KB
721 }
722 else { /* a typedef; text pattern inadequate */
2e314d68
KB
723 fprintf(outf, "%s\t%s\t%d\n",
724 node->entry, node->file, node->lno);
725 }
9927b527 726 else if (vflag)
2e314d68
KB
727 fprintf(stdout, "%s %s %d\n",
728 node->entry, node->file, (node->lno+63)/64);
f5c61c07
KB
729 else
730 fprintf(stdout, "%-16s%4d %-16s %s\n",
2e314d68
KB
731 node->entry, node->lno, node->file, node->pat);
732 put_entries(node->right);
16bc359f 733}
f5c61c07
KB
734char *dbp = lbuf;
735int pfcnt;
736
737PF_funcs(fi)
738 FILE *fi;
16bc359f 739{
f5c61c07 740
f5c61c07
KB
741 pfcnt = 0;
742 while (fgets(lbuf, sizeof(lbuf), fi)) {
743 lineno++;
744 dbp = lbuf;
745 if ( *dbp == '%' ) dbp++ ; /* Ratfor escape to fortran */
746 while (isspace(*dbp))
747 dbp++;
748 if (*dbp == 0)
749 continue;
750 switch (*dbp |' ') {
751
c30ca4f4 752 case 'i':
f5c61c07
KB
753 if (tail("integer"))
754 takeprec();
755 break;
c30ca4f4 756 case 'r':
f5c61c07
KB
757 if (tail("real"))
758 takeprec();
16bc359f 759 break;
c30ca4f4 760 case 'l':
f5c61c07
KB
761 if (tail("logical"))
762 takeprec();
16bc359f 763 break;
c30ca4f4 764 case 'c':
f5c61c07
KB
765 if (tail("complex") || tail("character"))
766 takeprec();
767 break;
c30ca4f4 768 case 'd':
f5c61c07
KB
769 if (tail("double")) {
770 while (isspace(*dbp))
771 dbp++;
772 if (*dbp == 0)
773 continue;
774 if (tail("precision"))
775 break;
776 continue;
777 }
16bc359f 778 break;
16bc359f 779 }
f5c61c07
KB
780 while (isspace(*dbp))
781 dbp++;
782 if (*dbp == 0)
783 continue;
784 switch (*dbp|' ') {
785
c30ca4f4 786 case 'f':
f5c61c07
KB
787 if (tail("function"))
788 getit();
789 continue;
c30ca4f4 790 case 's':
f5c61c07
KB
791 if (tail("subroutine"))
792 getit();
793 continue;
c30ca4f4 794 case 'p':
f5c61c07
KB
795 if (tail("program")) {
796 getit();
797 continue;
798 }
799 if (tail("procedure"))
800 getit();
801 continue;
802 }
803 }
804 return (pfcnt);
805}
806
807tail(cp)
808 char *cp;
809{
810 register int len = 0;
811
812 while (*cp && (*cp&~' ') == ((*(dbp+len))&~' '))
813 cp++, len++;
814 if (*cp == 0) {
815 dbp += len;
816 return (1);
817 }
818 return (0);
819}
820
821takeprec()
822{
823
824 while (isspace(*dbp))
825 dbp++;
826 if (*dbp != '*')
827 return;
828 dbp++;
829 while (isspace(*dbp))
830 dbp++;
831 if (!isdigit(*dbp)) {
832 --dbp; /* force failure */
833 return;
16bc359f 834 }
f5c61c07
KB
835 do
836 dbp++;
837 while (isdigit(*dbp));
838}
839
840getit()
841{
842 register char *cp;
843 char c;
844 char nambuf[BUFSIZ];
845
846 for (cp = lbuf; *cp; cp++)
847 ;
848 *--cp = 0; /* zap newline */
849 while (isspace(*dbp))
850 dbp++;
851 if (*dbp == 0 || !isalpha(*dbp))
852 return;
853 for (cp = dbp+1; *cp && (isalpha(*cp) || isdigit(*cp)); cp++)
854 continue;
855 c = cp[0];
856 cp[0] = 0;
857 strcpy(nambuf, dbp);
858 cp[0] = c;
c30ca4f4 859 pfnote(nambuf, lineno);
f5c61c07
KB
860 pfcnt++;
861}
862
863char *
864savestr(cp)
865 char *cp;
866{
867 register int len;
868 register char *dp;
869
870 len = strlen(cp);
871 dp = (char *)malloc(len+1);
872 strcpy(dp, cp);
873 return (dp);
874}
875
876/*
877 * Return the ptr in sp at which the character c last
878 * appears; NULL if not found
879 *
880 * Identical to v7 rindex, included for portability.
881 */
882
883char *
884rindex(sp, c)
885register char *sp, c;
886{
887 register char *r;
888
889 r = NULL;
890 do {
891 if (*sp == c)
892 r = sp;
893 } while (*sp++);
894 return(r);
16bc359f 895}
c30ca4f4
KB
896
897/*
898 * lisp tag functions
899 * just look for (def or (DEF
900 */
901
902L_funcs (fi)
903FILE *fi;
904{
905 register int special;
906
907 pfcnt = 0;
908 while (fgets(lbuf, sizeof(lbuf), fi)) {
909 lineno++;
910 dbp = lbuf;
911 if (dbp[0] == '(' &&
912 (dbp[1] == 'D' || dbp[1] == 'd') &&
913 (dbp[2] == 'E' || dbp[2] == 'e') &&
914 (dbp[3] == 'F' || dbp[3] == 'f')) {
915 dbp += 4;
916 if (striccmp(dbp, "method") == 0 ||
917 striccmp(dbp, "wrapper") == 0 ||
918 striccmp(dbp, "whopper") == 0)
919 special = TRUE;
920 else
921 special = FALSE;
922 while (!isspace(*dbp))
923 dbp++;
924 while (isspace(*dbp))
925 dbp++;
926 L_getit(special);
927 }
928 }
929}
930
931L_getit(special)
932int special;
933{
934 register char *cp;
935 register char c;
936 char nambuf[BUFSIZ];
937
938 for (cp = lbuf; *cp; cp++)
939 continue;
940 *--cp = 0; /* zap newline */
941 if (*dbp == 0)
942 return;
943 if (special) {
944 if ((cp = index(dbp, ')')) == NULL)
945 return;
946 while (cp >= dbp && *cp != ':')
947 cp--;
948 if (cp < dbp)
949 return;
950 dbp = cp;
951 while (*cp && *cp != ')' && *cp != ' ')
952 cp++;
953 }
954 else
955 for (cp = dbp + 1; *cp && *cp != '(' && *cp != ' '; cp++)
956 continue;
957 c = cp[0];
958 cp[0] = 0;
959 strcpy(nambuf, dbp);
960 cp[0] = c;
961 pfnote(nambuf, lineno,TRUE);
962 pfcnt++;
963}
964
965/*
966 * striccmp:
967 * Compare two strings over the length of the second, ignoring
968 * case distinctions. If they are the same, return 0. If they
969 * are different, return the difference of the first two different
970 * characters. It is assumed that the pattern (second string) is
971 * completely lower case.
972 */
973striccmp(str, pat)
974register char *str, *pat;
975{
976 register int c1;
977
978 while (*pat) {
979 if (isupper(*str))
980 c1 = tolower(*str);
981 else
982 c1 = *str;
983 if (c1 != *pat)
984 return c1 - *pat;
985 pat++;
986 str++;
987 }
988 return 0;
989}
990
991/*
992 * first_char:
993 * Return the first non-blank character in the file. After
994 * finding it, rewind the input file so we start at the beginning
995 * again.
996 */
997first_char()
998{
999 register int c;
1000 register long off;
1001
1002 off = ftell(inf);
1003 while ((c = getc(inf)) != EOF)
1004 if (!isspace(c) && c != '\r') {
1005 fseek(inf, off, 0);
1006 return c;
1007 }
1008 fseek(inf, off, 0);
1009 return EOF;
1010}
1011
1012/*
1013 * toss_yysec:
1014 * Toss away code until the next "%%" line.
1015 */
1016toss_yysec()
1017{
1018 char buf[BUFSIZ];
1019
1020 for (;;) {
1021 lineftell = ftell(inf);
1022 if (fgets(buf, BUFSIZ, inf) == NULL)
1023 return;
1024 lineno++;
1025 if (strncmp(buf, "%%", 2) == 0)
1026 return;
1027 }
1028}
1029