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