Commit | Line | Data |
---|---|---|
19966b15 KB |
1 | /* |
2 | * Copyright (c) 1987 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 | static char sccsid[] = "@(#)fortran.c 5.1 (Berkeley) %G%"; | |
9 | #endif not lint | |
10 | ||
11 | #include <ctags.h> | |
12 | #include <strings.h> | |
13 | ||
14 | char *lbp; /* line buffer pointer */ | |
15 | ||
16 | PF_funcs() | |
17 | { | |
18 | register bool pfcnt; /* pascal/fortran functions found */ | |
19 | register char *cp; | |
20 | char tok[MAXTOKEN], | |
21 | *gettoken(); | |
22 | ||
23 | for (pfcnt = NO;;) { | |
24 | lineftell = ftell(inf); | |
25 | if (!fgets(lbuf,sizeof(lbuf),inf)) | |
26 | return(pfcnt); | |
27 | ++lineno; | |
28 | lbp = lbuf; | |
29 | if (*lbp == '%') /* Ratfor escape to fortran */ | |
30 | ++lbp; | |
31 | for (;isspace(*lbp);++lbp); | |
32 | if (!*lbp) | |
33 | continue; | |
34 | switch (*lbp | ' ') { /* convert to lower-case */ | |
35 | case 'c': | |
36 | if (cicmp("complex") || cicmp("character")) | |
37 | takeprec(); | |
38 | break; | |
39 | case 'd': | |
40 | if (cicmp("double")) { | |
41 | for (;isspace(*lbp);++lbp); | |
42 | if (!*lbp) | |
43 | continue; | |
44 | if (cicmp("precision")) | |
45 | break; | |
46 | continue; | |
47 | } | |
48 | break; | |
49 | case 'i': | |
50 | if (cicmp("integer")) | |
51 | takeprec(); | |
52 | break; | |
53 | case 'l': | |
54 | if (cicmp("logical")) | |
55 | takeprec(); | |
56 | break; | |
57 | case 'r': | |
58 | if (cicmp("real")) | |
59 | takeprec(); | |
60 | break; | |
61 | } | |
62 | for (;isspace(*lbp);++lbp); | |
63 | if (!*lbp) | |
64 | continue; | |
65 | switch (*lbp | ' ') { | |
66 | case 'f': | |
67 | if (cicmp("function")) | |
68 | break; | |
69 | continue; | |
70 | case 'p': | |
71 | if (cicmp("program") || cicmp("procedure")) | |
72 | break; | |
73 | continue; | |
74 | case 's': | |
75 | if (cicmp("subroutine")) | |
76 | break; | |
77 | default: | |
78 | continue; | |
79 | } | |
80 | for (;isspace(*lbp);++lbp); | |
81 | if (!*lbp) | |
82 | continue; | |
83 | for (cp = lbp + 1;*cp && intoken(*cp);++cp); | |
84 | if (cp = lbp + 1) | |
85 | continue; | |
86 | *cp = EOS; | |
87 | (void)strcpy(tok,lbp); | |
88 | getline(); /* process line for ex(1) */ | |
89 | pfnote(tok,lineno); | |
90 | pfcnt = YES; | |
91 | } | |
92 | /*NOTREACHED*/ | |
93 | } | |
94 | ||
95 | /* | |
96 | * cicmp -- | |
97 | * do case-independent strcmp | |
98 | */ | |
99 | cicmp(cp) | |
100 | register char *cp; | |
101 | { | |
102 | register int len; | |
103 | register char *bp; | |
104 | ||
105 | for (len = 0,bp = lbp;*cp && (*cp &~ ' ') == (*bp++ &~ ' '); | |
106 | ++cp,++len); | |
107 | if (!*cp) { | |
108 | lbp += len; | |
109 | return(YES); | |
110 | } | |
111 | return(NO); | |
112 | } | |
113 | ||
114 | static | |
115 | takeprec() | |
116 | { | |
117 | for (;isspace(*lbp);++lbp); | |
118 | if (*lbp == '*') { | |
119 | for (++lbp;isspace(*lbp);++lbp); | |
120 | if (!isdigit(*lbp)) | |
121 | --lbp; /* force failure */ | |
122 | else | |
123 | while (isdigit(*++lbp)); | |
124 | } | |
125 | } |