[project @ 1996-07-19 18:36:04 by partain]
[ghc-hetmet.git] / glafp-utils / etags / etags.c
1 /* Tags file maker to go with GNUmacs
2    Copyright (C) 1984, 1987, 1988 Free Software Foundation, Inc. and Ken Arnold
3
4                            NO WARRANTY
5
6   BECAUSE THIS PROGRAM IS LICENSED FREE OF CHARGE, WE PROVIDE ABSOLUTELY
7 NO WARRANTY, TO THE EXTENT PERMITTED BY APPLICABLE STATE LAW.  EXCEPT
8 WHEN OTHERWISE STATED IN WRITING, FREE SOFTWARE FOUNDATION, INC,
9 RICHARD M. STALLMAN AND/OR OTHER PARTIES PROVIDE THIS PROGRAM "AS IS"
10 WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,
11 BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
12 FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY
13 AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE
14 DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
15 CORRECTION.
16
17  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW WILL RICHARD M.
18 STALLMAN, THE FREE SOFTWARE FOUNDATION, INC., AND/OR ANY OTHER PARTY
19 WHO MAY MODIFY AND REDISTRIBUTE THIS PROGRAM AS PERMITTED BELOW, BE
20 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY LOST PROFITS, LOST MONIES, OR
21 OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
22 USE OR INABILITY TO USE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR
23 DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY THIRD PARTIES OR
24 A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS) THIS
25 PROGRAM, EVEN IF YOU HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH
26 DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY.
27
28                 GENERAL PUBLIC LICENSE TO COPY
29
30   1. You may copy and distribute verbatim copies of this source file
31 as you receive it, in any medium, provided that you conspicuously
32 and appropriately publish on each copy a valid copyright notice
33 "Copyright (C) 1986 Free Software Foundation"; and include
34 following the copyright notice a verbatim copy of the above disclaimer
35 of warranty and of this License.
36
37   2. You may modify your copy or copies of this source file or
38 any portion of it, and copy and distribute such modifications under
39 the terms of Paragraph 1 above, provided that you also do the following:
40
41     a) cause the modified files to carry prominent notices stating
42     that you changed the files and the date of any change; and
43
44     b) cause the whole of any work that you distribute or publish,
45     that in whole or in part contains or is a derivative of this
46     program or any part thereof, to be licensed at no charge to all
47     third parties on terms identical to those contained in this
48     License Agreement (except that you may choose to grant more extensive
49     warranty protection to some or all third parties, at your option).
50
51     c) You may charge a distribution fee for the physical act of
52     transferring a copy, and you may at your option offer warranty
53     protection in exchange for a fee.
54
55 Mere aggregation of another unrelated program with this program (or its
56 derivative) on a volume of a storage or distribution medium does not bring
57 the other program under the scope of these terms.
58
59   3. You may copy and distribute this program (or a portion or derivative
60 of it, under Paragraph 2) in object code or executable form under the terms
61 of Paragraphs 1 and 2 above provided that you also do one of the following:
62
63     a) accompany it with the complete corresponding machine-readable
64     source code, which must be distributed under the terms of
65     Paragraphs 1 and 2 above; or,
66
67     b) accompany it with a written offer, valid for at least three
68     years, to give any third party free (except for a nominal
69     shipping charge) a complete machine-readable copy of the
70     corresponding source code, to be distributed under the terms of
71     Paragraphs 1 and 2 above; or,
72
73     c) accompany it with the information you received as to where the
74     corresponding source code may be obtained.  (This alternative is
75     allowed only for noncommercial distribution and only if you
76     received the program in object code or executable form alone.)
77
78 For an executable file, complete source code means all the source code for
79 all modules it contains; but, as a special exception, it need not include
80 source code for modules which are standard libraries that accompany the
81 operating system on which the executable file runs.
82
83   4. You may not copy, sublicense, distribute or transfer this program
84 except as expressly provided under this License Agreement.  Any attempt
85 otherwise to copy, sublicense, distribute or transfer this program is void and
86 your rights to use the program under this License agreement shall be
87 automatically terminated.  However, parties who have received computer
88 software programs from you with this License Agreement will not have
89 their licenses terminated so long as such parties remain in full compliance.
90
91 In other words, you are welcome to use, share and improve this program.
92 You are forbidden to forbid anyone else to use, share and improve
93 what you give them.   Help stamp out software-hoarding!  */
94
95 #include <stdio.h>
96 #include <ctype.h>
97
98 /* Define the symbol ETAGS to make the program "etags",
99  which makes emacs-style tag tables by default.
100  Define CTAGS to make the program "ctags" compatible with the usual one.
101  Define neither one to get behavior that depends
102  on the name with which the program is invoked
103  (but we don't normally compile it that way).  */
104
105 /* On VMS, CTAGS is not useful, so always do ETAGS.  */
106 #ifdef VMS
107 #ifndef ETAGS
108 #define ETAGS
109 #endif
110 #endif
111
112 /* Exit codes for success and failure.  */
113
114 #ifdef VMS
115 #define GOOD    (1)
116 #define BAD     (0)
117 #else
118 #define GOOD    (0)
119 #define BAD     (1)
120 #endif
121
122 #define reg     register
123 #define logical char
124
125 #ifndef TRUE
126 #define TRUE    (1)
127 #endif
128
129 #ifndef FALSE
130 #define FALSE   (0)
131 #endif
132
133 #define iswhite(arg)    (_wht[arg])     /* T if char is white           */
134 #define begtoken(arg)   (_btk[arg])     /* T if char can start token    */
135 #define intoken(arg)    (_itk[arg])     /* T if char can be in token    */
136 #define endtoken(arg)   (_etk[arg])     /* T if char ends tokens        */
137 #define isgood(arg)     (_gd[arg])      /* T if char can be after ')'   */
138
139 #define max(I1,I2)      (I1 > I2 ? I1 : I2)
140
141 /* cause token checking for typedef, struct, union, enum to distinguish
142    keywords from identifier-prefixes (e.g. struct vs struct_tag).  */
143 #define istoken(s, tok, len) (!strncmp(s,tok,len) && endtoken(*((s)+(len))))
144
145 struct  nd_st {                 /* sorting structure                    */
146         char    *name;                  /* function or type name        */
147         char    *file;                  /* file name                    */
148         logical f;                      /* use pattern or line no       */
149         int     lno;                    /* line number tag is on        */
150         long    cno;                    /* character number line starts on */
151         char    *pat;                   /* search pattern               */
152         logical been_warned;            /* set if noticed dup           */
153         struct  nd_st   *left,*right;   /* left and right sons          */
154 };
155
156 long    ftell();
157 typedef struct  nd_st   NODE;
158
159 int number; /* tokens found so far on line starting with # (including #) */
160 logical gotone,                         /* found a func already on line */
161                                         /* boolean "func" (see init)    */
162         _wht[0177],_etk[0177],_itk[0177],_btk[0177],_gd[0177];
163
164         /* typedefs are recognized using a simple finite automata,
165          * tydef is its state variable.
166          */
167 typedef enum {none, begin, tag_ok, middle, end } TYST;
168
169 TYST tydef = none;
170
171 char    searchar = '/';                 /* use /.../ searches           */
172
173 int     lineno;                 /* line number of current line */
174 long    charno;                 /* current character number */
175 long    linecharno;             /* character number of start of line */
176
177 char    *curfile,               /* current input file name              */
178         *outfile= 0,            /* output file                          */
179         *white  = " \f\t\n",    /* white chars                          */
180         *endtk  = " \t\n\"'#()[]{}=-+%*/&|^~!<>;,.:?",
181                                 /* token ending chars                   */
182         *begtk  = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$",
183                                 /* token starting chars                 */
184         *intk   = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$0123456789",
185                                 /* valid in-token chars                 */
186         *notgd  = ",;";         /* non-valid after-function chars       */
187
188 int     file_num = 0;           /* current file number                  */
189 int     aflag = 0;              /* -a: append to tags */
190 int     tflag = 0;              /* -t: create tags for typedefs */
191 int     uflag = 0;              /* -u: update tags */
192 int     wflag = 0;              /* -w: suppress warnings */
193 int     vflag = 0;              /* -v: create vgrind style index output */
194 int     xflag = 0;              /* -x: create cxref style output */
195 int     eflag = 0;              /* -e: emacs style output */
196
197 /* Name this program was invoked with.  */
198 char *progname;
199
200 FILE    *inf,                   /* ioptr for current input file         */
201         *outf;                  /* ioptr for tags file                  */
202
203 NODE    *head;                  /* the head of the sorted binary tree   */
204
205 char *savestr();
206 char *savenstr ();
207 char *rindex();
208 char *index();
209 char *concat ();
210 void initbuffer ();
211 long readline ();
212
213 /* A `struct linebuffer' is a structure which holds a line of text.
214  `readline' reads a line from a stream into a linebuffer
215  and works regardless of the length of the line.  */
216
217 struct linebuffer
218   {
219     long size;
220     char *buffer;
221   };
222
223 struct linebuffer lb, lb1;
224 \f
225 #if 0  /* VMS now provides the `system' function.  */
226 #ifdef VMS
227
228 #include <descrip.h>
229
230 void
231 system (buf)
232      char *buf;
233 {
234   struct dsc$descriptor_s command =
235     {
236       strlen(buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf
237     };
238
239   LIB$SPAWN(&command);
240 }
241 #endif /* VMS */
242 #endif /* 0 */
243 \f
244 main(ac,av)
245      int        ac;
246      char       *av[];
247 {
248   char cmd[100];
249   int i;
250   int fflag = 0;
251   char *this_file;
252 #ifdef VMS
253   char got_err;
254
255   extern char *gfnames();
256   extern char *massage_name();
257 #endif
258
259   progname = av[0];
260
261 #ifdef ETAGS
262   eflag = 1;
263 #else
264 #ifdef CTAGS
265   eflag = 0;
266 #else
267   {
268     char *subname = rindex (progname, '/');
269     if (subname++ == NULL)
270       subname = progname;
271     eflag = ! strcmp(subname, "ctags");
272   }
273 #endif
274 #endif
275
276   while (ac > 1 && av[1][0] == '-')
277     {
278       for (i=1; av[1][i]; i++)
279         {
280           switch(av[1][i])
281             {
282 #ifndef VMS  /* These options are useful only with ctags,
283                 and VMS can't input them, so just omit them.  */
284             case 'B':
285               searchar='?';
286               eflag = 0;
287               break;
288             case 'F':
289               searchar='/';
290               eflag = 0;
291               break;
292 #endif
293             case 'a':
294               aflag++;
295               break;
296             case 'e':
297               eflag++;
298               break;
299             case 'f':
300               if (fflag > 0)
301                 {
302                   fprintf(stderr,
303                           "%s: -f flag may only be given once\n", progname);
304                   goto usage;
305                 }
306               fflag++, ac--; av++;
307               if (ac <= 1 || av[1][0] == '\0')
308                 {
309                   fprintf(stderr,
310                           "%s: -f flag must be followed by a filename\n",
311                           progname);
312                   goto usage;
313                 }
314               outfile = av[1];
315               goto end_loop;
316             case 't':
317               tflag++;
318               break;
319 #ifndef VMS
320             case 'u':
321               uflag++;
322               eflag = 0;
323               break;
324 #endif
325             case 'w':
326               wflag++;
327               break;
328             case 'v':
329               vflag++;
330               xflag++;
331               eflag = 0;
332               break;
333             case 'x':
334               xflag++;
335               eflag = 0;
336               break;
337             default:
338               goto usage;
339             }
340         }
341     end_loop: ;
342       ac--; av++;
343     }
344
345   if (ac <= 1)
346     {
347     usage:
348 #ifdef VMS
349       fprintf (stderr, "Usage: %s [-aetwvx] [-f outfile] file ...\n", progname);
350 #else
351       fprintf (stderr, "Usage: %s [-BFaetuwvx] [-f outfile] file ...\n", progname);
352 #endif
353       exit(BAD);
354     }
355
356   if (outfile == 0)
357     {
358       outfile = eflag ? "TAGS" : "tags";
359     }
360
361   init();                       /* set up boolean "functions"           */
362
363   initbuffer (&lb);
364   initbuffer (&lb1);
365   /*
366    * loop through files finding functions
367    */
368   if (eflag)
369     {
370       outf = fopen (outfile, aflag ? "a" : "w");
371       if (!outf)
372         {
373           fprintf (stderr, "%s: ", progname);
374           perror (outfile);
375           exit (BAD);
376         }
377     }
378
379   file_num = 1;
380 #ifdef VMS
381   for (ac--, av++;
382        (this_file = gfnames (&ac, &av, &got_err)) != NULL; file_num++)
383     {
384       if (got_err)
385         {
386           error("Can't find file %s\n", this_file);
387           ac--, av++;
388         }
389       else
390         {
391           this_file = massage_name (this_file);
392 #else     
393   for (; file_num < ac; file_num++)
394     {
395       this_file = av[file_num];
396       if (1)
397         {
398 #endif
399           find_entries (this_file);
400           if (eflag)
401             {
402               fprintf (outf, "\f\n%s,%d\n",
403                        this_file, total_size_of_entries (head));
404               put_entries (head);
405               free_tree (head);
406               head = NULL;
407             }
408         }
409     }
410
411   if (eflag)
412     {
413       fclose (outf);
414       exit (GOOD);
415     }
416
417   if (xflag)
418     {
419       put_entries(head);
420       exit(GOOD);
421     }
422   if (uflag)
423     {
424       for (i=1; i<ac; i++)
425         {
426           sprintf(cmd,
427                   "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS",
428                   outfile, av[i], outfile);
429           system(cmd);
430         }
431       aflag++;
432     }
433   outf = fopen(outfile, aflag ? "a" : "w");
434   if (outf == NULL)
435     {
436       fprintf (stderr, "%s: ", outfile);
437       perror(outfile);
438       exit(BAD);
439     }
440   put_entries(head);
441   fclose(outf);
442 #ifndef VMS
443   if (uflag)
444     {
445       sprintf(cmd, "sort %s -o %s", outfile, outfile);
446       system(cmd);
447     }
448 #endif
449   exit(GOOD);
450 }
451
452 /*
453  * This routine sets up the boolean psuedo-functions which work
454  * by seting boolean flags dependent upon the corresponding character
455  * Every char which is NOT in that string is not a white char.  Therefore,
456  * all of the array "_wht" is set to FALSE, and then the elements
457  * subscripted by the chars in "white" are set to TRUE.  Thus "_wht"
458  * of a char is TRUE if it is the string "white", else FALSE.
459  */
460 init()
461 {
462
463   reg char *sp;
464   reg int i;
465
466   for (i = 0; i < 0177; i++)
467     {
468       _wht[i] = _etk[i] = _itk[i] = _btk[i] = FALSE;
469       _gd[i] = TRUE;
470     }
471   for (sp = white; *sp; sp++)
472     _wht[*sp] = TRUE;
473   for (sp = endtk; *sp; sp++)
474     _etk[*sp] = TRUE;
475   for (sp = intk; *sp; sp++)
476     _itk[*sp] = TRUE;
477   for (sp = begtk; *sp; sp++)
478     _btk[*sp] = TRUE;
479   for (sp = notgd; *sp; sp++)
480     _gd[*sp] = FALSE;
481   _wht[0] = _wht['\n'];
482   _etk[0] = _etk['\n'];
483   _btk[0] = _btk['\n'];
484   _itk[0] = _itk['\n'];
485   _gd[0] = _gd['\n'];
486 }
487
488 /*
489  * This routine opens the specified file and calls the function
490  * which finds the function and type definitions.
491  */
492 find_entries (file)
493      char *file;
494 {
495   char *cp;
496
497   if ((inf=fopen(file,"r")) == NULL)
498     {
499       fprintf (stderr, "%s: ", progname);
500       perror(file);
501       return;
502     }
503   curfile = savestr(file);
504   cp = rindex(file, '.');
505   /* .tex, .aux or .bbl implies LaTeX source code */
506   if (cp && (!strcmp (cp + 1, "tex") || !strcmp (cp + 1, "aux")
507              || !strcmp (cp + 1, "bbl")))
508     {
509       TEX_funcs(inf);
510       fclose(inf);
511       return;
512     }
513   /* .l or .el or .lisp (or .cl or .clisp or ...) implies lisp source code */
514   if (cp && (!strcmp (cp + 1, "l") ||
515              !strcmp (cp + 1, "el") ||
516              !strcmp (cp + 1, "lsp") ||
517              !strcmp (cp + 1, "lisp") ||
518              !strcmp (cp + 1, "cl") ||
519              !strcmp (cp + 1, "clisp")))
520     {
521       L_funcs(inf);
522       fclose(inf);
523       return;
524     }
525   /* .scm or .sm or .scheme implies scheme source code */
526   if (cp && (!strcmp (cp + 1, "sm")
527              || !strcmp (cp + 1, "scm")
528              || !strcmp (cp + 1, "scheme")
529              || !strcmp (cp + 1, "t")
530              || !strcmp (cp + 1, "sch")
531              || !strcmp (cp + 1, "SM")
532              || !strcmp (cp + 1, "SCM")
533              /* The `SCM' or `scm' prefix with a version number */
534              || (cp[-1] == 'm' && cp[-2] == 'c' && cp[-3] == 's')
535              || (cp[-1] == 'M' && cp[-2] == 'C' && cp[-3] == 'S')))
536     {
537       Scheme_funcs(inf);
538       fclose(inf);
539       return;
540     }
541   /* .M implies Mcode source code */
542   if (cp && !strcmp (cp + 1, "M"))
543     {
544       Mcode_funcs(inf);
545       fclose(inf);
546       return;
547     }
548
549   /* if not a .c or .h or .y file, try fortran */
550   if (cp && (cp[1] != 'c' && cp[1] != 'h' && cp[1] != 'y')
551       && cp[2] == '\0')
552     {
553       if (PF_funcs(inf) != 0)
554         {
555           fclose(inf);
556           return;
557         }
558       rewind(inf);      /* no fortran tags found, try C */
559     }
560   C_entries();
561   fclose(inf);
562 }
563 \f
564 /* Record a tag on the current line.
565   name is the tag name,
566   f is nonzero to use a pattern, zero to use line number instead. */
567
568 pfnote (name, f, linestart, linelen, lno, cno)
569      char *name;
570      logical f;                 /* f == TRUE when function */
571      char *linestart;
572      int linelen;
573      int lno;
574      long cno;
575 {
576   register char *fp;
577   register NODE *np;
578   char *altname;
579   char tem[51];
580
581   if ((np = (NODE *) malloc (sizeof (NODE))) == NULL)
582     {
583       fprintf(stderr, "%s: too many entries to sort\n", progname);
584       put_entries(head);
585       free_tree(head);
586       head = NULL;
587       np = (NODE *) xmalloc(sizeof (NODE));
588     }
589   /* Change name "main" to M<thisfilename>. */
590   if (!eflag && !xflag && !strcmp(name, "main"))
591     {
592       fp = rindex(curfile, '/');
593       if (fp == 0)
594         fp = curfile;
595       else
596         fp++;
597       altname = concat ("M", fp, "");
598       fp = rindex(altname, '.');
599       if (fp && fp[2] == 0)
600         *fp = 0;
601       name = altname;
602     }
603   np->name = savestr(name);
604   np->file = curfile;
605   np->f = f;
606   np->lno = lno;
607   np->cno = cno;
608   np->left = np->right = 0;
609   if (eflag)
610     {
611       linestart[linelen] = 0;
612     }
613   else if (xflag == 0)
614     {
615       sprintf (tem, strlen (linestart) < 50 ? "%s$" : "%.50s", linestart);
616       linestart = tem;
617     }
618   np->pat = savestr (linestart);
619   if (head == NULL)
620     head = np;
621   else
622     add_node(np, head);
623 }
624
625 free_tree(node)
626      NODE *node;
627 {
628   while (node)
629     {
630       free_tree(node->right);
631       free(node);
632       node = node->left;
633     }
634 }
635
636 add_node(node, cur_node)
637      NODE *node,*cur_node;
638 {
639   register int dif;
640
641   dif = strcmp(node->name, cur_node->name);
642
643   /* If this tag name matches an existing one, then
644      unless -e was given, do not add the node, but maybe print a warning */
645   if (!eflag && !dif)
646     {
647       if (node->file == cur_node->file)
648         {
649           if (!wflag)
650             {
651               fprintf(stderr,"%s: Duplicate entry in file %s, line %d: %s\n",
652                       progname, node->file,lineno,node->name);
653               fprintf(stderr,"Second entry ignored\n");
654             }
655           return;
656         }
657       if (!cur_node->been_warned)
658         if (!wflag)
659           fprintf(stderr,"%s: Duplicate entry in files %s and %s: %s (Warning only)\n",
660                   progname, node->file, cur_node->file, node->name);
661       cur_node->been_warned = TRUE;
662       return;
663     } 
664
665   /* Actually add the node */
666   if (dif < 0) 
667     {
668       if (cur_node->left != NULL)
669         add_node(node,cur_node->left);
670       else
671         cur_node->left = node;
672       return;
673     }
674   if (cur_node->right != NULL)
675     add_node(node,cur_node->right);
676   else
677     cur_node->right = node;
678 }
679 \f
680 put_entries(node)
681      reg NODE *node;
682 {
683   reg char *sp;
684
685   if (node == NULL)
686     return;
687
688   /* Output subentries that precede this one */
689   put_entries (node->left);
690
691   /* Output this entry */
692
693   if (eflag)
694     {
695       fprintf (outf, "%s%c%d,%d\n",
696                node->pat, 0177, node->lno, node->cno);
697     }
698   else if (!xflag)
699     {
700       fprintf (outf, "%s\t%s\t",
701                node->name, node->file);
702
703       if (node->f)
704         {               /* a function */
705           putc (searchar, outf);
706           putc ('^', outf);
707
708           for (sp = node->pat; *sp; sp++)
709             {
710               if (*sp == '\\' || *sp == searchar)
711                 putc ('\\', outf);
712               putc (*sp, outf);
713             }
714           putc (searchar, outf);
715         }
716       else
717         {               /* a typedef; text pattern inadequate */
718           fprintf (outf, "%d", node->lno);
719         }
720       putc ('\n', outf);
721     }
722   else if (vflag)
723     fprintf (stdout, "%s %s %d\n",
724              node->name, node->file, (node->lno+63)/64);
725   else
726     fprintf (stdout, "%-16s%4d %-16s %s\n",
727              node->name, node->lno, node->file, node->pat);
728
729   /* Output subentries that follow this one */
730   put_entries (node->right);
731 }
732
733 /* Return total number of characters that put_entries will output for
734  the nodes in the subtree of the specified node.
735  Works only if eflag is set, but called only in that case.  */
736
737 total_size_of_entries(node)
738      reg NODE *node;
739 {
740   reg int total = 0;
741   reg long num;
742
743   if (node == NULL)
744     return 0;
745
746   /* Count subentries that precede this one */
747   total = total_size_of_entries (node->left);
748
749   /* Count subentries that follow this one */
750   total += total_size_of_entries (node->right);
751
752   /* Count this entry */
753
754   total += strlen (node->pat) + 3;
755
756   num = node->lno;
757   while (num)
758     {
759       total++;
760       num /= 10;
761     }
762
763   num = node->cno;
764   if (!num) total++;
765   while (num)
766     {
767       total++;
768       num /= 10;
769     }
770   return total;
771 }
772 \f
773 /*
774  * This routine finds functions and typedefs in C syntax and adds them
775  * to the list.
776  */
777 #ifdef VMS
778 long vmslinecharno;
779 #define VMS_SET_LINECHARNO      (vmslinecharno = ftell(inf))
780 #else
781 #define VMS_SET_LINECHARNO
782 #endif
783
784 #define CNL_SAVE_NUMBER \
785 { \
786   VMS_SET_LINECHARNO; \
787   linecharno = charno; lineno++; \
788   charno += 1 + readline (&lb, inf); \
789   lp = lb.buffer; \
790 }
791
792 #define CNL \
793 { \
794   CNL_SAVE_NUMBER; \
795   number = 0; \
796 }
797
798 C_entries ()
799 {
800   register int c;
801   register char *token, *tp, *lp;
802   logical incomm, inquote, inchar, midtoken;
803   int level;
804   char tok[BUFSIZ];
805
806   lineno = 0;
807   charno = 0;
808   lp = lb.buffer;
809   *lp = 0;
810
811   number = 0;
812   gotone = midtoken = inquote = inchar = incomm = FALSE;
813   level = 0;
814
815   while (!feof (inf))
816     {
817       c = *lp++;
818       if (c == 0)
819         {
820           CNL;
821           gotone = FALSE;
822         }
823       if (c == '\\')
824         {
825           c = *lp++;
826           if (c == 0)
827             CNL_SAVE_NUMBER;
828           c = ' ';
829         } 
830       else if (incomm)
831         {
832           if (c == '*')
833             {
834               while ((c = *lp++) == '*')
835                 continue;
836               if (c == 0)
837                 CNL;
838               if (c == '/')
839                 incomm = FALSE;
840             }
841         }
842       else if (inquote)
843         {
844           /*
845           * Too dumb to know about \" not being magic, but
846           * they usually occur in pairs anyway.
847           */
848           if (c == '"')
849             inquote = FALSE;
850           continue;
851         }
852       else if (inchar)
853         {
854           if (c == '\'')
855             inchar = FALSE;
856           continue;
857         }
858       else switch (c)
859         {
860         case '"':
861           inquote = TRUE;
862           continue;
863         case '\'':
864           inchar = TRUE;
865           continue;
866         case '/':
867           if (*lp == '*')
868             {
869               lp++;
870               incomm = TRUE;
871             }
872           continue;
873         case '#':
874           if (lp == lb.buffer + 1)
875             number = 1;
876           continue;
877         case '{':
878           if (tydef == tag_ok)
879             {
880               tydef=middle;
881             }
882           level++;
883           continue;
884         case '}':
885           if (lp == lb.buffer + 1)
886             level = 0;  /* reset */
887           else
888             level--;
889           if (!level && tydef==middle)
890             {
891               tydef=end;
892             }
893           continue;
894         }
895       if (!level && !inquote && !incomm && gotone == FALSE)
896         {
897           if (midtoken)
898             {
899               if (endtoken(c))
900                 {
901                   int f;
902                   char *buf = lb.buffer;
903                   int endpos = lp - lb.buffer;
904                   char *lp1 = lp;
905                   int line = lineno;
906                   long linestart = linecharno;
907 #ifdef VMS
908                   long vmslinestart = vmslinecharno;
909 #endif
910                   int tem = consider_token (&lp1, token, &f, level);
911                   lp = lp1;
912                   if (tem)
913                     {
914                       if (linestart != linecharno)
915                         {
916 #ifdef VMS
917                           getline (vmslinestart);
918 #else
919                           getline (linestart);
920 #endif
921                           strncpy (tok, token + (lb1.buffer - buf),
922                                    tp-token+1);
923                           tok[tp-token+1] = 0;
924                           pfnote(tok, f, lb1.buffer, endpos, line, linestart);
925                         }
926                       else
927                         {
928                           strncpy (tok, token, tp-token+1);
929                           tok[tp-token+1] = 0;
930                           pfnote(tok, f, lb.buffer, endpos, line, linestart);
931                         }
932                       gotone = f;       /* function */
933                     }
934                   midtoken = FALSE;
935                   token = lp - 1;
936                 }
937               else if (intoken(c))
938                 tp++;
939             }
940           else if (begtoken(c))
941             {
942               token = tp = lp - 1;
943               midtoken = TRUE;
944             }
945         }
946       if (c == ';'  &&  tydef==end)     /* clean with typedefs */
947         tydef=none;
948     }
949 }
950
951 /*
952  * This routine  checks to see if the current token is
953  * at the start of a function, or corresponds to a typedef
954  * It updates the input line * so that the '(' will be
955  * in it when it returns.
956  */
957 consider_token (lpp, token, f, level)
958      char **lpp, *token;
959      int *f, level;
960 {
961   reg char *lp = *lpp;
962   reg char c;
963   static logical next_token_is_func;
964   logical firsttok;     /* T if have seen first token in ()'s */
965   int bad, win;
966
967   *f = 1;                       /* a function */
968   c = lp[-1];
969   bad = FALSE;
970   if (!number)
971     {           /* space is not allowed in macro defs   */
972       while (iswhite(c))
973         {
974           c = *lp++;
975           if (c == 0)
976             {
977               if (feof (inf))
978                 break;
979               CNL;
980             }
981         }
982     }
983   else
984     {
985       /* the following tries to make it so that a #define a b(c)        */
986       /* doesn't count as a define of b.                                */
987
988       number++;
989       if (number >= 4  || (number==2 && strncmp (token, "define", 6)==0))
990         {
991           /* Force the next symbol to be recognised, even if it is #define a b(c)! */
992           if(number == 2) next_token_is_func = 1;
993           else
994             gotone = TRUE;
995         badone:
996           bad = TRUE;
997           goto ret;
998         }
999     }
1000   /* check for the typedef cases                */
1001   if (tflag && istoken(token, "typedef", 7))
1002     {
1003       tydef=begin;
1004       goto badone;
1005     }
1006   if (tydef==begin && (istoken(token, "struct", 6) ||
1007                        istoken(token, "union", 5) || istoken(token, "enum", 4)))
1008   {
1009     tydef=tag_ok;      
1010     goto badone;
1011   }
1012   if (tydef==tag_ok)
1013     {
1014       tydef=middle;
1015       goto badone;
1016     }
1017   if (tydef==begin)             /* e.g. typedef ->int<- */
1018     {
1019       tydef=end;
1020       goto badone;
1021     }
1022   if (tydef==middle && level == 0) /* e.g. typedef struct tag ->struct_t<- */
1023     {
1024       tydef=end;
1025     }
1026   if (tydef==end)
1027     {
1028       *f = 0;
1029       win = 1;
1030       goto ret;
1031     }
1032   /* Detect GNUmacs's function-defining macros. */
1033   if (!number && !strncmp (token, "DEF", 3))
1034          
1035     {
1036       next_token_is_func = 1;
1037       goto badone;
1038     }
1039   if (next_token_is_func)
1040     {
1041       next_token_is_func = 0;
1042       win = 1;
1043       goto ret;
1044     }
1045   if (c != '(')
1046     goto badone;
1047   firsttok = FALSE;
1048   while ((c = *lp++) != ')')
1049     {
1050       if (c == 0)
1051         {
1052           if (feof (inf))
1053             break;
1054           CNL;
1055         }
1056       /*
1057         * This line used to confuse ctags:
1058         *       int     (*oldhup)();
1059         * This fixes it. A nonwhite char before the first
1060         * token, other than a / (in case of a comment in there)
1061         * makes this not a declaration.
1062         */
1063       if (begtoken(c) || c=='/') firsttok++;
1064       else if (!iswhite(c) && !firsttok) goto badone;
1065     }
1066   while (iswhite (c = *lp++))
1067     {
1068       if (c == 0)
1069         {
1070           if (feof (inf))
1071             break;
1072           CNL;
1073         }
1074     }
1075   win = isgood (c);
1076 ret:
1077   *lpp = lp - 1;
1078   return !bad && win;
1079 }
1080
1081 getline (atchar)
1082      long atchar;
1083 {
1084   long saveftell = ftell (inf);
1085
1086   fseek (inf, atchar, 0);
1087   readline (&lb1, inf);
1088   fseek (inf, saveftell, 0);
1089 }
1090 \f
1091 /* Fortran parsing */
1092
1093 char    *dbp;
1094 int     pfcnt;
1095
1096 PF_funcs(fi)
1097      FILE *fi;
1098 {
1099   lineno = 0;
1100   charno = 0;
1101   pfcnt = 0;
1102
1103   while (!feof (fi))
1104     {
1105       lineno++;
1106       linecharno = charno;
1107       charno += readline (&lb, fi) + 1;
1108       dbp = lb.buffer;
1109       if (*dbp == '%') dbp++ ;  /* Ratfor escape to fortran */
1110       while (isspace(*dbp))
1111         dbp++;
1112       if (*dbp == 0)
1113         continue;
1114       switch (*dbp |' ')
1115         {
1116         case 'i':
1117           if (tail("integer"))
1118             takeprec();
1119           break;
1120         case 'r':
1121           if (tail("real"))
1122             takeprec();
1123           break;
1124         case 'l':
1125           if (tail("logical"))
1126             takeprec();
1127           break;
1128         case 'c':
1129           if (tail("complex") || tail("character"))
1130             takeprec();
1131           break;
1132         case 'd':
1133           if (tail("double"))
1134             {
1135               while (isspace(*dbp))
1136                 dbp++;
1137               if (*dbp == 0)
1138                 continue;
1139               if (tail("precision"))
1140                 break;
1141               continue;
1142             }
1143           break;
1144         }
1145       while (isspace(*dbp))
1146         dbp++;
1147       if (*dbp == 0)
1148         continue;
1149       switch (*dbp|' ')
1150         {
1151         case 'f':
1152           if (tail("function"))
1153             getit();
1154           continue;
1155         case 's':
1156           if (tail("subroutine"))
1157             getit();
1158           continue;
1159         case 'p':
1160           if (tail("program"))
1161             {
1162               getit();
1163               continue;
1164             }
1165           if (tail("procedure"))
1166             getit();
1167           continue;
1168         }
1169     }
1170   return (pfcnt);
1171 }
1172
1173 tail(cp)
1174      char *cp;
1175 {
1176   register int len = 0;
1177
1178   while (*cp && (*cp&~' ') == ((*(dbp+len))&~' '))
1179     cp++, len++;
1180   if (*cp == 0)
1181     {
1182       dbp += len;
1183       return (1);
1184     }
1185   return (0);
1186 }
1187
1188 takeprec()
1189 {
1190   while (isspace(*dbp))
1191     dbp++;
1192   if (*dbp != '*')
1193     return;
1194   dbp++;
1195   while (isspace(*dbp))
1196     dbp++;
1197   if (!isdigit(*dbp))
1198     {
1199       --dbp;            /* force failure */
1200       return;
1201     }
1202   do
1203     dbp++;
1204   while (isdigit(*dbp));
1205 }
1206
1207 getit()
1208 {
1209   register char *cp;
1210   char c;
1211   char nambuf[BUFSIZ];
1212
1213   while (isspace(*dbp))
1214     dbp++;
1215   if (*dbp == 0 || !isalpha(*dbp))
1216     return;
1217   for (cp = dbp+1; *cp && (isalpha(*cp) || isdigit(*cp)); cp++)
1218     continue;
1219   c = cp[0];
1220   cp[0] = 0;
1221   strcpy(nambuf, dbp);
1222   cp[0] = c;
1223   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
1224   pfcnt++;
1225 }
1226 \f
1227 /*
1228  * lisp tag functions
1229  * just look for (def or (DEF
1230  */
1231
1232 L_funcs (fi)
1233      FILE *fi;
1234 {
1235   lineno = 0;
1236   charno = 0;
1237   pfcnt = 0;
1238
1239   while (!feof (fi))
1240     {
1241       lineno++;
1242       linecharno = charno;
1243       charno += readline (&lb, fi) + 1;
1244       dbp = lb.buffer;
1245       if (dbp[0] == '(' && 
1246           (dbp[1] == 'D' || dbp[1] == 'd') &&
1247             (dbp[2] == 'E' || dbp[2] == 'e') &&
1248               (dbp[3] == 'F' || dbp[3] == 'f'))
1249         {
1250           while (!isspace(*dbp)) dbp++;
1251           while (isspace(*dbp)) dbp++;
1252           L_getit();
1253         }
1254     }
1255 }
1256
1257 L_getit()
1258 {
1259   register char *cp;
1260   char c;
1261   char nambuf[BUFSIZ];
1262
1263   if (*dbp == 0) return;
1264   for (cp = dbp+1; *cp && *cp != '(' && *cp != ' '; cp++)
1265     continue;
1266   c = cp[0];
1267   cp[0] = 0;
1268   strcpy(nambuf, dbp);
1269   cp[0] = c;
1270   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
1271   pfcnt++;
1272 }
1273 \f
1274 /*
1275  * Scheme tag functions
1276  * look for (def... xyzzy
1277  * look for (def... (xyzzy
1278  * look for (def ... ((...(xyzzy ....
1279  * look for (set! xyzzy
1280  */
1281
1282 static get_scheme ();
1283 Scheme_funcs (fi)
1284      FILE *fi;
1285 {
1286   lineno = 0;
1287   charno = 0;
1288   pfcnt = 0;
1289
1290   while (!feof (fi))
1291     {
1292       lineno++;
1293       linecharno = charno;
1294       charno += readline (&lb, fi) + 1;
1295       dbp = lb.buffer;
1296       if (dbp[0] == '(' && 
1297           (dbp[1] == 'D' || dbp[1] == 'd') &&
1298             (dbp[2] == 'E' || dbp[2] == 'e') &&
1299               (dbp[3] == 'F' || dbp[3] == 'f'))
1300         {
1301           while (!isspace(*dbp)) dbp++;
1302           /* Skip over open parens and white space */
1303           while (*dbp && (isspace(*dbp) || *dbp == '(')) dbp++;
1304           get_scheme ();
1305         }
1306       if (dbp[0] == '(' && 
1307           (dbp[1] == 'S' || dbp[1] == 's') &&
1308             (dbp[2] == 'E' || dbp[2] == 'e') &&
1309               (dbp[3] == 'T' || dbp[3] == 't') &&
1310                 (dbp[4] == '!' || dbp[4] == '!') &&
1311                   (isspace(dbp[5])))
1312         {
1313           while (!isspace(*dbp)) dbp++;
1314           /* Skip over white space */
1315           while (isspace(*dbp)) dbp++;
1316           get_scheme ();
1317         }
1318     }
1319 }
1320
1321 static
1322 get_scheme()
1323 {
1324   register char *cp;
1325   char c;
1326   char nambuf[BUFSIZ];
1327
1328   if (*dbp == 0) return;
1329   /* Go till you get to white space or a syntactic break */
1330   for (cp = dbp+1; *cp && *cp != '(' && *cp != ')' && !isspace(*cp); cp++)
1331     continue;
1332   /* Null terminate the string there. */
1333   c = cp[0];
1334   cp[0] = 0;
1335   /* Copy the string */
1336   strcpy(nambuf, dbp);
1337   /* Unterminate the string */
1338   cp[0] = c;
1339   /* Announce the change */
1340   pfnote(nambuf, TRUE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
1341   pfcnt++;
1342 }
1343 static get_mcode ();
1344 Mcode_funcs (fi)
1345      FILE *fi;
1346 {
1347   lineno = 0;
1348   charno = 0;
1349   pfcnt = 0;
1350
1351   while (!feof (fi))
1352     {
1353       lineno++;
1354       linecharno = charno;
1355       charno += readline (&lb, fi) + 1;
1356       dbp = lb.buffer;
1357
1358       while (*dbp != 0)
1359         {
1360           /* Skip over white space */
1361           while (isspace(*dbp)) dbp++;
1362           get_mcode();
1363         }
1364     }
1365 }
1366
1367 static
1368 get_mcode()
1369 {
1370   register char *cp;
1371   char c;
1372   char nambuf[BUFSIZ];
1373
1374   if (*dbp == 0) return;
1375   /* Go till you get to white space or a syntactic break */
1376   for (cp = dbp; *cp && *cp != ':' && *cp != ';' && !isspace(*cp); cp++)
1377     continue;
1378
1379   if(*cp == ':')
1380     {
1381       /* Null terminate the string there. */
1382       c = cp[0];
1383       cp[0] = 0;
1384       /* Copy the string */
1385       strcpy(nambuf, dbp);
1386       /* Unterminate the string */
1387       cp[0] = c;
1388       /* Announce the change */
1389       pfnote(nambuf, TRUE, lb.buffer, strlen(lb.buffer), lineno, linecharno);
1390       pfcnt++;
1391       *dbp = 0;
1392     }
1393   if (*cp == ';')
1394     *dbp = 0;
1395   else
1396     dbp = cp;
1397 }
1398 \f
1399 /* Find tags in TeX and LaTeX input files.  */
1400
1401 /* TEX_toktab is a table of TeX control sequences that define tags.
1402    Each TEX_tabent records one such control sequence.  */
1403
1404 struct TEX_tabent
1405 {
1406   char *name;
1407   int len;
1408 };
1409
1410 struct TEX_tabent *TEX_toktab = NULL; /* Table with tag tokens */
1411
1412 /* Default set of control sequences to put into TEX_toktab.
1413    The value of environment var TEXTAGS is prepended to this.  */
1414
1415 static char *TEX_defenv =
1416   ":chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem:typeout";
1417
1418 struct TEX_tabent *TEX_decode_env (); 
1419
1420 static char TEX_esc = '\\';
1421 static char TEX_opgrp = '{';
1422 static char TEX_clgrp = '}';
1423
1424 /*
1425  * TeX/LaTeX scanning loop.
1426  */
1427
1428 TEX_funcs (fi)
1429     FILE *fi;
1430 {
1431   char *lasthit;
1432
1433   lineno = 0;
1434   charno = 0;
1435   pfcnt = 0;
1436
1437   /* Select either \ or ! as escape character.  */
1438   TEX_mode (fi);
1439
1440   /* Initialize token table once from environment. */
1441   if (!TEX_toktab)
1442     TEX_toktab = TEX_decode_env ("TEXTAGS", TEX_defenv);
1443
1444   while (!feof (fi))
1445     {
1446       lineno++;
1447       linecharno = charno;
1448       charno += readline (&lb, fi) + 1;
1449       dbp = lb.buffer;
1450       lasthit = dbp;
1451
1452       while (!feof (fi))
1453         {       /* Scan each line in file */
1454           lineno++;
1455           linecharno = charno;
1456           charno += readline (&lb, fi) + 1;
1457           dbp = lb.buffer;
1458           lasthit = dbp;
1459           while (dbp = index (dbp, TEX_esc)) /* Look at each escape in line */
1460             {
1461               register int i;
1462
1463               if (! *(++dbp))
1464                 break;
1465               linecharno += dbp - lasthit;
1466               lasthit = dbp;
1467               i = TEX_Token (lasthit);
1468               if (0 <= i)
1469                 {
1470                   TEX_getit (lasthit, TEX_toktab[i].len);
1471                   break;                /* We only save a line once */
1472                 }
1473             }
1474         }
1475     }
1476 }
1477
1478 #define TEX_LESC '\\'
1479 #define TEX_SESC '!'
1480
1481 /* Figure out whether TeX's escapechar is '\\' or '!' and set grouping */
1482 /* chars accordingly. */
1483
1484 TEX_mode (f)
1485      FILE *f;
1486 {
1487   int c;
1488
1489   while ((c = getc (f)) != EOF)
1490     if (c == TEX_LESC || c == TEX_SESC)
1491       break;
1492
1493   if (c == TEX_LESC)
1494     {
1495       TEX_esc = TEX_LESC;
1496       TEX_opgrp = '{';
1497       TEX_clgrp = '}';
1498     } 
1499   else
1500     {
1501       TEX_esc = TEX_SESC;
1502       TEX_opgrp = '<';
1503       TEX_clgrp = '>';
1504     }
1505   rewind (f);
1506 }
1507
1508 /* Read environment and prepend it to the default string. */
1509 /* Build token table. */
1510
1511 struct TEX_tabent *
1512 TEX_decode_env (evarname, defenv)
1513      char *evarname;
1514      char *defenv;
1515 {
1516   register char *env, *p;
1517   extern char *savenstr (), *index ();
1518
1519   struct TEX_tabent *tab;
1520   int size, i;
1521
1522   /* Append deafult string to environment. */
1523   env = (char *) getenv (evarname);
1524   if (!env)
1525     env = defenv;
1526   else
1527     env = concat (env, defenv, "");
1528
1529   /* Allocate a token table */
1530   for (size = 1, p=env; p;)
1531     if ((p = index (p, ':')) && *(++p))
1532       size++;
1533   tab = (struct TEX_tabent *) xmalloc (size * sizeof (struct TEX_tabent));
1534
1535   /* Unpack environment string into token table. Be careful about */
1536   /* zero-length strings (leading ':', "::" and trailing ':') */
1537   for (i = 0; *env;)
1538     {
1539       p = index (env, ':');
1540       if (!p)                   /* End of environment string. */
1541         p = env + strlen (env);
1542       if (p - env > 0)
1543         {       /* Only non-zero strings. */
1544           tab[i].name = savenstr (env, p - env);
1545           tab[i].len = strlen (tab[i].name);
1546           i++;
1547         }
1548       if (*p)
1549         env = p + 1;
1550       else
1551         {
1552           tab[i].name = NULL;   /* Mark end of table. */
1553           tab[i].len = 0;
1554           break;
1555         }
1556     }
1557   return tab;
1558 }
1559
1560 /* Record a tag defined by a TeX command of length LEN and starting at NAME.
1561    The name being defined actually starts at (NAME + LEN + 1).
1562    But we seem to include the TeX command in the tag name.  */
1563
1564 TEX_getit (name, len)
1565     char *name;
1566     int len;
1567 {
1568   char *p = name + len;
1569   char nambuf[BUFSIZ];
1570
1571   if (*name == 0) return;
1572
1573   /* Let tag name extend to next group close (or end of line) */
1574   while (*p && *p != TEX_clgrp)
1575     p++;
1576   strncpy (nambuf, name, p - name);
1577   nambuf[p - name] = 0;
1578
1579   pfnote (nambuf, TRUE, lb.buffer, strlen (lb.buffer), lineno, linecharno);
1580   pfcnt++;
1581 }
1582
1583 /* If the text at CP matches one of the tag-defining TeX command names,
1584    return the index of that command in TEX_toktab.
1585    Otherwise return -1.  */
1586
1587 /* Keep the capital `T' in `Token' for dumb truncating compilers
1588    (this distinguishes it from `TEX_toktab' */
1589 TEX_Token (cp)
1590     char *cp;
1591 {
1592   int i;
1593
1594   for (i = 0; TEX_toktab[i].len > 0; i++)
1595     if (strncmp (TEX_toktab[i].name, cp, TEX_toktab[i].len) == 0)
1596       return i;
1597   return -1;
1598 }
1599 \f
1600 /* Initialize a linebuffer for use */
1601
1602 void
1603 initbuffer (linebuffer)
1604      struct linebuffer *linebuffer;
1605 {
1606   linebuffer->size = 200;
1607   linebuffer->buffer = (char *) xmalloc (200);
1608 }
1609
1610 /* Read a line of text from `stream' into `linebuffer'.
1611  Return the length of the line.  */
1612
1613 long
1614 readline (linebuffer, stream)
1615      struct linebuffer *linebuffer;
1616      register FILE *stream;
1617 {
1618   char *buffer = linebuffer->buffer;
1619   register char *p = linebuffer->buffer;
1620   register char *pend = p + linebuffer->size;
1621
1622   while (1)
1623     {
1624       int c = getc (stream);
1625       if (p == pend)
1626         {
1627           linebuffer->size *= 2;
1628           buffer = (char *) xrealloc (buffer, linebuffer->size);
1629           p += buffer - linebuffer->buffer;
1630           pend = buffer + linebuffer->size;
1631           linebuffer->buffer = buffer;
1632         }
1633       if (c < 0 || c == '\n')
1634         {
1635           *p = 0;
1636           break;
1637         }
1638       *p++ = c;
1639     }
1640
1641   return p - buffer;
1642 }
1643 \f
1644 char *
1645 savestr(cp)
1646      char *cp;
1647 {
1648   return savenstr (cp, strlen (cp));
1649 }
1650
1651 char *
1652 savenstr(cp, len)
1653     char *cp;
1654     int len;
1655 {
1656   register char *dp;
1657
1658   dp = (char *) xmalloc (len + 1);
1659   strncpy (dp, cp, len);
1660   dp[len] = '\0';
1661   return dp;
1662 }
1663
1664 /*
1665  * Return the ptr in sp at which the character c last
1666  * appears; NULL if not found
1667  *
1668  * Identical to v7 rindex, included for portability.
1669  */
1670
1671 char *
1672 rindex(sp, c)
1673      register char *sp, c;
1674 {
1675   register char *r;
1676
1677   r = NULL;
1678   do
1679     {
1680       if (*sp == c)
1681         r = sp;
1682     } while (*sp++);
1683   return(r);
1684 }
1685
1686 /*
1687  * Return the ptr in sp at which the character c first
1688  * appears; NULL if not found
1689  *
1690  * Identical to v7 index, included for portability.
1691  */
1692
1693 char *
1694 index(sp, c)
1695      register char *sp, c;
1696 {
1697   do
1698     {
1699       if (*sp == c)
1700         return (sp);
1701     } while (*sp++);
1702   return (NULL);
1703 }
1704
1705 /* Print error message and exit.  */
1706
1707 fatal (s1, s2)
1708      char *s1, *s2;
1709 {
1710   error (s1, s2);
1711   exit (BAD);
1712 }
1713
1714 /* Print error message.  `s1' is printf control string, `s2' is arg for it. */
1715
1716 error (s1, s2)
1717      char *s1, *s2;
1718 {
1719   fprintf (stderr, "%s: ", progname);
1720   fprintf (stderr, s1, s2);
1721   fprintf (stderr, "\n");
1722 }
1723
1724 /* Return a newly-allocated string whose contents concatenate those of s1, s2, s3.  */
1725
1726 char *
1727 concat (s1, s2, s3)
1728      char *s1, *s2, *s3;
1729 {
1730   int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3);
1731   char *result = (char *) xmalloc (len1 + len2 + len3 + 1);
1732
1733   strcpy (result, s1);
1734   strcpy (result + len1, s2);
1735   strcpy (result + len1 + len2, s3);
1736   *(result + len1 + len2 + len3) = 0;
1737
1738   return result;
1739 }
1740
1741 /* Like malloc but get fatal error if memory is exhausted.  */
1742
1743 int
1744 xmalloc (size)
1745      int size;
1746 {
1747   int result = malloc (size);
1748   if (!result)
1749     fatal ("virtual memory exhausted", 0);
1750   return result;
1751 }
1752
1753 int
1754 xrealloc (ptr, size)
1755      char *ptr;
1756      int size;
1757 {
1758   int result = realloc (ptr, size);
1759   if (!result)
1760     fatal ("virtual memory exhausted");
1761   return result;
1762 }