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) 03/16/87"; 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 } 126