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