![[BACK]](/icons/back.gif){kind=icon}
Return to fortran.c CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [local] / src / usr.bin / ctags|
Return to fortran.c CVS log | Up to [local] / src / usr.bin / ctags |
1.1 deraadt 1: /* $NetBSD: fortran.c,v 1.3 1995/03/26 20:14:08 glass Exp $ */
2:
3: /*
4: * Copyright (c) 1987, 1993, 1994
5: * The Regents of the University of California. All rights reserved.
6: *
7: * Redistribution and use in source and binary forms, with or without
8: * modification, are permitted provided that the following conditions
9: * are met:
10: * 1. Redistributions of source code must retain the above copyright
11: * notice, this list of conditions and the following disclaimer.
12: * 2. Redistributions in binary form must reproduce the above copyright
13: * notice, this list of conditions and the following disclaimer in the
14: * documentation and/or other materials provided with the distribution.
15: * 3. All advertising materials mentioning features or use of this software
16: * must display the following acknowledgement:
17: * This product includes software developed by the University of
18: * California, Berkeley and its contributors.
19: * 4. Neither the name of the University nor the names of its contributors
20: * may be used to endorse or promote products derived from this software
21: * without specific prior written permission.
22: *
23: * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
24: * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
25: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26: * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
27: * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28: * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
29: * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
30: * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31: * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
32: * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
33: * SUCH DAMAGE.
34: */
35:
36: #ifndef lint
37: #if 0
38: static char sccsid[] = "@(#)fortran.c 8.3 (Berkeley) 4/2/94";
39: #else
40: static char rcsid[] = "$NetBSD: fortran.c,v 1.3 1995/03/26 20:14:08 glass Exp $";
41: #endif
42: #endif /* not lint */
43:
44: #include <ctype.h>
45: #include <limits.h>
46: #include <stdio.h>
47: #include <string.h>
48:
49: #include "ctags.h"
50:
51: static void takeprec __P((void));
52:
53: char *lbp; /* line buffer pointer */
54:
55: int
56: PF_funcs()
57: {
58: bool pfcnt; /* pascal/fortran functions found */
59: char *cp;
60: char tok[MAXTOKEN];
61:
62: for (pfcnt = NO;;) {
63: lineftell = ftell(inf);
64: if (!fgets(lbuf, sizeof(lbuf), inf))
65: return (pfcnt);
66: ++lineno;
67: lbp = lbuf;
68: if (*lbp == '%') /* Ratfor escape to fortran */
69: ++lbp;
70: for (; isspace(*lbp); ++lbp)
71: continue;
72: if (!*lbp)
73: continue;
74: switch (*lbp | ' ') { /* convert to lower-case */
75: case 'c':
76: if (cicmp("complex") || cicmp("character"))
77: takeprec();
78: break;
79: case 'd':
80: if (cicmp("double")) {
81: for (; isspace(*lbp); ++lbp)
82: continue;
83: if (!*lbp)
84: continue;
85: if (cicmp("precision"))
86: break;
87: continue;
88: }
89: break;
90: case 'i':
91: if (cicmp("integer"))
92: takeprec();
93: break;
94: case 'l':
95: if (cicmp("logical"))
96: takeprec();
97: break;
98: case 'r':
99: if (cicmp("real"))
100: takeprec();
101: break;
102: }
103: for (; isspace(*lbp); ++lbp)
104: continue;
105: if (!*lbp)
106: continue;
107: switch (*lbp | ' ') {
108: case 'f':
109: if (cicmp("function"))
110: break;
111: continue;
112: case 'p':
113: if (cicmp("program") || cicmp("procedure"))
114: break;
115: continue;
116: case 's':
117: if (cicmp("subroutine"))
118: break;
119: default:
120: continue;
121: }
122: for (; isspace(*lbp); ++lbp)
123: continue;
124: if (!*lbp)
125: continue;
126: for (cp = lbp + 1; *cp && intoken(*cp); ++cp)
127: continue;
128: if (cp = lbp + 1)
129: continue;
130: *cp = EOS;
131: (void)strcpy(tok, lbp);
132: getline(); /* process line for ex(1) */
133: pfnote(tok, lineno);
134: pfcnt = YES;
135: }
136: /*NOTREACHED*/
137: }
138:
139: /*
140: * cicmp --
141: * do case-independent strcmp
142: */
143: int
144: cicmp(cp)
145: char *cp;
146: {
147: int len;
148: char *bp;
149:
150: for (len = 0, bp = lbp; *cp && (*cp &~ ' ') == (*bp++ &~ ' ');
151: ++cp, ++len)
152: continue;
153: if (!*cp) {
154: lbp += len;
155: return (YES);
156: }
157: return (NO);
158: }
159:
160: static void
161: takeprec()
162: {
163: for (; isspace(*lbp); ++lbp)
164: continue;
165: if (*lbp == '*') {
166: for (++lbp; isspace(*lbp); ++lbp)
167: continue;
168: if (!isdigit(*lbp))
169: --lbp; /* force failure */
170: else
171: while (isdigit(*++lbp))
172: continue;
173: }
174: }