4.3BSD - /usr/src/ucb/ctags.c

   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
   8: char 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
  14: static char sccsid[] = "@(#)ctags.c	5.1 (Berkeley) 5/31/85";
  15: #endif not lint
  16: 
  17: #include <stdio.h>
  18: #include <ctype.h>
  19: 
  20: /*
  21:  * ctags: create a tags file
  22:  */
  23: 
  24: #define reg register
  25: #define bool    char
  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: 
  38: struct  nd_st {         /* sorting structure			*/
  39:     char    *entry;         /* function or type name	*/
  40:     char    *file;          /* file name			*/
  41:     bool    f;          /* use pattern or line no	*/
  42:     int lno;            /* for -x option		*/
  43:     char    *pat;           /* search pattern		*/
  44:     bool    been_warned;        /* set if noticed dup		*/
  45:     struct  nd_st   *left,*right;   /* left and right sons		*/
  46: };
  47: 
  48: long    ftell();
  49: typedef struct  nd_st   NODE;
  50: 
  51: bool    number,             /* T if on line starting with #	*/
  52:     term    = FALSE,        /* T if print on terminal	*/
  53:     makefile= TRUE,         /* T if to creat "tags" file	*/
  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: 
  58:     /* typedefs are recognized using a simple finite automata,
  59: 	 * tydef is its state variable.
  60: 	 */
  61: typedef enum {none, begin, middle, end } TYST;
  62: 
  63: TYST tydef = none;
  64: 
  65: char    searchar = '/';         /* use /.../ searches 		*/
  66: 
  67: int lineno;             /* line number of current line */
  68: char    line[4*BUFSIZ],     /* current input line			*/
  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			*/
  76:     *intk   = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz0123456789",
  77:                 /* valid in-token chars			*/
  78:     *notgd  = ",;";     /* non-valid after-function chars	*/
  79: 
  80: int file_num;       /* current file number			*/
  81: int aflag;          /* -a: append to tags */
  82: int tflag;          /* -t: create tags for typedefs */
  83: int uflag;          /* -u: update tags */
  84: int wflag;          /* -w: suppress warnings */
  85: int vflag;          /* -v: create vgrind style index output */
  86: int xflag;          /* -x: create cxref style output */
  87: 
  88: char    lbuf[BUFSIZ];
  89: 
  90: FILE    *inf,           /* ioptr for current input file		*/
  91:     *outf;          /* ioptr for tags file			*/
  92: 
  93: long    lineftell;      /* ftell after getc( inf ) == '\n' 	*/
  94: 
  95: NODE    *head;          /* the head of the sorted binary tree	*/
  96: 
  97: char    *savestr();
  98: char    *rindex(), *index();
  99: char    *toss_comment();
 100: 
 101: main(ac,av)
 102: int ac;
 103: char    *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]) {
 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)
 138:                     goto usage;
 139:                 ac--, av++;
 140:                 outfile = av[1];
 141:                 goto next;
 142:               default:
 143:                 goto usage;
 144:         }
 145:         }
 146:     next:
 147:         ac--; av++;
 148:     }
 149: 
 150:     if (ac <= 1) {
 151: usage:
 152:         printf("Usage: ctags [-BFatuwvx] [-f tagsfile] file ...\n");
 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++)
 161:         find_entries(av[file_num]);
 162: 
 163:     if (xflag) {
 164:         put_entries(head);
 165:         exit(0);
 166:     }
 167:     if (uflag) {
 168:         for (i=1; i<ac; i++) {
 169:             sprintf(cmd,
 170:                 "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS",
 171:                 outfile, av[i], outfile);
 172:             system(cmd);
 173:         }
 174:         aflag++;
 175:     }
 176:     outf = fopen(outfile, aflag ? "a" : "w");
 177:     if (outf == NULL) {
 178:         perror(outfile);
 179:         exit(1);
 180:     }
 181:     put_entries(head);
 182:     fclose(outf);
 183:     if (uflag) {
 184:         sprintf(cmd, "sort %s -o %s", outfile, outfile);
 185:         system(cmd);
 186:     }
 187:     exit(0);
 188: }
 189: 
 190: /*
 191:  * This routine sets up the boolean psuedo-functions which work
 192:  * by seting boolean flags dependent upon the corresponding character
 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.
 197:  */
 198: init()
 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: /*
 221:  * This routine opens the specified file and calls the function
 222:  * which finds the function and type definitions.
 223:  */
 224: find_entries(file)
 225: char    *file;
 226: {
 227:     char *cp;
 228: 
 229:     if ((inf = fopen(file,"r")) == NULL) {
 230:         perror(file);
 231:         return;
 232:     }
 233:     curfile = savestr(file);
 234:     lineno = 0;
 235:     cp = rindex(file, '.');
 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();
 251:             C_entries();
 252:             fclose(inf);
 253:             return;
 254:         }
 255:     }
 256:     /* .y implies a yacc file */
 257:     if (cp && cp[1] == 'y' && cp[2] == '\0') {
 258:         toss_yysec();
 259:         Y_entries();
 260:         C_entries();
 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();
 273:     fclose(inf);
 274: }
 275: 
 276: pfnote(name, ln, f)
 277: char    *name;
 278: int ln;
 279: bool    f;      /* f == TRUE when function */
 280: {
 281:     register char *fp;
 282:     register NODE *np;
 283:     char nbuf[BUFSIZ];
 284: 
 285:     if ((np = (NODE *) malloc(sizeof (NODE))) == NULL) {
 286:         fprintf(stderr, "ctags: too many entries to sort\n");
 287:         put_entries(head);
 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:     }
 303:     np->entry = savestr(name);
 304:     np->file = curfile;
 305:     np->f = f;
 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: 
 320: /*
 321:  * This routine finds functions and typedefs in C syntax and adds them
 322:  * to the list.
 323:  */
 324: C_entries()
 325: {
 326:     register int c;
 327:     register char *token, *tp;
 328:     bool incomm, inquote, inchar, midtoken;
 329:     int level;
 330:     char *sp;
 331:     char tok[BUFSIZ];
 332: 
 333:     number = gotone = midtoken = inquote = inchar = incomm = FALSE;
 334:     level = 0;
 335:     sp = tp = token = line;
 336:     lineno++;
 337:     lineftell = ftell(inf);
 338:     for (;;) {
 339:         *sp = c = getc(inf);
 340:         if (feof(inf))
 341:             break;
 342:         if (c == '\n')
 343:             lineno++;
 344:         else if (c == '\\') {
 345:             c = *++sp = getc(inf);
 346:             if (c == '\n')
 347:                 c = ' ';
 348:         }
 349:         else if (incomm) {
 350:             if (c == '*') {
 351:                 while ((*++sp=c=getc(inf)) == '*')
 352:                     continue;
 353:                 if (c == '\n')
 354:                     lineno++;
 355:                 if (c == '/')
 356:                     incomm = FALSE;
 357:             }
 358:         }
 359:         else if (inquote) {
 360:             /*
 361: 			 * Too dumb to know about \" not being magic, but
 362: 			 * they usually occur in pairs anyway.
 363: 			 */
 364:             if (c == '"')
 365:                 inquote = FALSE;
 366:             continue;
 367:         }
 368:         else if (inchar) {
 369:             if (c == '\'')
 370:                 inchar = FALSE;
 371:             continue;
 372:         }
 373:         else switch (c) {
 374:           case '"':
 375:             inquote = TRUE;
 376:             continue;
 377:           case '\'':
 378:             inchar = TRUE;
 379:             continue;
 380:           case '/':
 381:             if ((*++sp=c=getc(inf)) == '*')
 382:                 incomm = TRUE;
 383:             else
 384:                 ungetc(*sp, inf);
 385:             continue;
 386:           case '#':
 387:             if (sp == line)
 388:                 number = TRUE;
 389:             continue;
 390:           case '{':
 391:             if (tydef == begin) {
 392:                 tydef=middle;
 393:             }
 394:             level++;
 395:             continue;
 396:           case '}':
 397:             if (sp == line)
 398:                 level = 0;  /* reset */
 399:             else
 400:                 level--;
 401:             if (!level && tydef==middle) {
 402:                 tydef=end;
 403:             }
 404:             continue;
 405:         }
 406:         if (!level && !inquote && !incomm && gotone == FALSE) {
 407:             if (midtoken) {
 408:                 if (endtoken(c)) {
 409:                     int f;
 410:                     int pfline = lineno;
 411:                     if (start_entry(&sp,token,tp,&f)) {
 412:                         strncpy(tok,token,tp-token+1);
 413:                         tok[tp-token+1] = 0;
 414:                         getline();
 415:                         pfnote(tok, pfline, f);
 416:                         gotone = f; /* function */
 417:                     }
 418:                     midtoken = FALSE;
 419:                     token = sp;
 420:                 }
 421:                 else if (intoken(c))
 422:                     tp++;
 423:             }
 424:             else if (begtoken(c)) {
 425:                 token = tp = sp;
 426:                 midtoken = TRUE;
 427:             }
 428:         }
 429:         if (c == ';'  &&  tydef==end)   /* clean with typedefs */
 430:             tydef=none;
 431:         sp++;
 432:         if (c == '\n' || sp > &line[sizeof (line) - BUFSIZ]) {
 433:             tp = token = sp = line;
 434:             lineftell = ftell(inf);
 435:             number = gotone = midtoken = inquote = inchar = FALSE;
 436:         }
 437:     }
 438: }
 439: 
 440: /*
 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.
 445:  */
 446: start_entry(lp,token,tp,f)
 447: char    **lp,*token,*tp;
 448: int *f;
 449: {
 450:     reg char    c,*sp,*tsp;
 451:     static  bool    found;
 452:     bool    firsttok;       /* T if have seen first token in ()'s */
 453:     int bad;
 454: 
 455:     *f = 1;         /* a function */
 456:     sp = *lp;
 457:     c = *sp;
 458:     bad = FALSE;
 459:     if (!number) {      /* space is not allowed in macro defs	*/
 460:         while (iswhite(c)) {
 461:             *++sp = c = getc(inf);
 462:             if (c == '\n') {
 463:                 lineno++;
 464:                 if (sp > &line[sizeof (line) - BUFSIZ])
 465:                     goto ret;
 466:             }
 467:         }
 468:     /* the following tries to make it so that a #define a b(c)	*/
 469:     /* doesn't count as a define of b.				*/
 470:     }
 471:     else {
 472:         if (!strncmp(token, "define", 6))
 473:             found = 0;
 474:         else
 475:             found++;
 476:         if (found >= 2) {
 477:             gotone = TRUE;
 478: badone:         bad = TRUE;
 479:             goto ret;
 480:         }
 481:     }
 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:     }
 499:     if (c != '(')
 500:         goto badone;
 501:     firsttok = FALSE;
 502:     while ((*++sp=c=getc(inf)) != ')') {
 503:         if (c == '\n') {
 504:             lineno++;
 505:             if (sp > &line[sizeof (line) - BUFSIZ])
 506:                 goto ret;
 507:         }
 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: 		 */
 515:         if (begtoken(c) || c=='/')
 516:             firsttok++;
 517:         else if (!iswhite(c) && !firsttok)
 518:             goto badone;
 519:     }
 520:     while (iswhite(*++sp=c=getc(inf)))
 521:         if (c == '\n') {
 522:             lineno++;
 523:             if (sp > &line[sizeof (line) - BUFSIZ])
 524:                 break;
 525:         }
 526: ret:
 527:     *lp = --sp;
 528:     if (c == '\n')
 529:         lineno--;
 530:     ungetc(c,inf);
 531:     return !bad && (!*f || isgood(c));
 532:                     /* hack for typedefs */
 533: }
 534: 
 535: /*
 536:  * Y_entries:
 537:  *	Find the yacc tags and put them in.
 538:  */
 539: Y_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: 
 621: char *
 622: toss_comment(start)
 623: char    *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: 
 641: getline()
 642: {
 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);
 652: }
 653: 
 654: free_tree(node)
 655: NODE    *node;
 656: {
 657: 
 658:     while (node) {
 659:         free_tree(node->right);
 660:         cfree(node);
 661:         node = node->left;
 662:     }
 663: }
 664: 
 665: add_node(node, cur_node)
 666:     NODE *node,*cur_node;
 667: {
 668:     register int dif;
 669: 
 670:     dif = strcmp(node->entry, cur_node->entry);
 671:     if (dif == 0) {
 672:         if (node->file == cur_node->file) {
 673:             if (!wflag) {
 674: fprintf(stderr,"Duplicate entry in file %s, line %d: %s\n",
 675:     node->file,lineno,node->entry);
 676: fprintf(stderr,"Second entry ignored\n");
 677:             }
 678:             return;
 679:         }
 680:         if (!cur_node->been_warned)
 681:             if (!wflag)
 682: fprintf(stderr,"Duplicate entry in files %s and %s: %s (Warning only)\n",
 683:     node->file, cur_node->file, node->entry);
 684:         cur_node->been_warned = TRUE;
 685:         return;
 686:     }
 687: 
 688:     if (dif < 0) {
 689:         if (cur_node->left != NULL)
 690:             add_node(node,cur_node->left);
 691:         else
 692:             cur_node->left = node;
 693:         return;
 694:     }
 695:     if (cur_node->right != NULL)
 696:         add_node(node,cur_node->right);
 697:     else
 698:         cur_node->right = node;
 699: }
 700: 
 701: put_entries(node)
 702: reg NODE    *node;
 703: {
 704:     reg char    *sp;
 705: 
 706:     if (node == NULL)
 707:         return;
 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);
 721:         }
 722:         else {      /* a typedef; text pattern inadequate */
 723:             fprintf(outf, "%s\t%s\t%d\n",
 724:                 node->entry, node->file, node->lno);
 725:         }
 726:     else if (vflag)
 727:         fprintf(stdout, "%s %s %d\n",
 728:                 node->entry, node->file, (node->lno+63)/64);
 729:     else
 730:         fprintf(stdout, "%-16s%4d %-16s %s\n",
 731:             node->entry, node->lno, node->file, node->pat);
 732:     put_entries(node->right);
 733: }
 734: char    *dbp = lbuf;
 735: int pfcnt;
 736: 
 737: PF_funcs(fi)
 738:     FILE *fi;
 739: {
 740: 
 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: 
 752:           case 'i':
 753:             if (tail("integer"))
 754:                 takeprec();
 755:             break;
 756:           case 'r':
 757:             if (tail("real"))
 758:                 takeprec();
 759:             break;
 760:           case 'l':
 761:             if (tail("logical"))
 762:                 takeprec();
 763:             break;
 764:           case 'c':
 765:             if (tail("complex") || tail("character"))
 766:                 takeprec();
 767:             break;
 768:           case 'd':
 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:             }
 778:             break;
 779:         }
 780:         while (isspace(*dbp))
 781:             dbp++;
 782:         if (*dbp == 0)
 783:             continue;
 784:         switch (*dbp|' ') {
 785: 
 786:           case 'f':
 787:             if (tail("function"))
 788:                 getit();
 789:             continue;
 790:           case 's':
 791:             if (tail("subroutine"))
 792:                 getit();
 793:             continue;
 794:           case 'p':
 795:             if (tail("program")) {
 796:                 getit();
 797:                 continue;
 798:             }
 799:             if (tail("procedure"))
 800:                 getit();
 801:             continue;
 802:         }
 803:     }
 804:     return (pfcnt);
 805: }
 806: 
 807: tail(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: 
 821: takeprec()
 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;
 834:     }
 835:     do
 836:         dbp++;
 837:     while (isdigit(*dbp));
 838: }
 839: 
 840: getit()
 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;
 859:     pfnote(nambuf, lineno);
 860:     pfcnt++;
 861: }
 862: 
 863: char *
 864: savestr(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: 
 883: char *
 884: rindex(sp, c)
 885: register 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);
 895: }
 896: 
 897: /*
 898:  * lisp tag functions
 899:  * just look for (def or (DEF
 900:  */
 901: 
 902: L_funcs (fi)
 903: FILE *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: 
 931: L_getit(special)
 932: int 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:  */
 973: striccmp(str, pat)
 974: register 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:  */
 997: first_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:  */
1016: toss_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: }

Defined functions

Defined variables

Defined struct's

Defined typedef's

Defined macros