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