11590Srgrimes/* 21590Srgrimes * Copyright (c) 1987, 1993, 1994 31590Srgrimes * The Regents of the University of California. All rights reserved. 41590Srgrimes * 51590Srgrimes * Redistribution and use in source and binary forms, with or without 61590Srgrimes * modification, are permitted provided that the following conditions 71590Srgrimes * are met: 81590Srgrimes * 1. Redistributions of source code must retain the above copyright 91590Srgrimes * notice, this list of conditions and the following disclaimer. 101590Srgrimes * 2. Redistributions in binary form must reproduce the above copyright 111590Srgrimes * notice, this list of conditions and the following disclaimer in the 121590Srgrimes * documentation and/or other materials provided with the distribution. 131590Srgrimes * 4. Neither the name of the University nor the names of its contributors 141590Srgrimes * may be used to endorse or promote products derived from this software 151590Srgrimes * without specific prior written permission. 161590Srgrimes * 171590Srgrimes * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 181590Srgrimes * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 191590Srgrimes * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 201590Srgrimes * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 211590Srgrimes * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 221590Srgrimes * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 231590Srgrimes * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 241590Srgrimes * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 251590Srgrimes * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 261590Srgrimes * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 271590Srgrimes * SUCH DAMAGE. 281590Srgrimes */ 291590Srgrimes 3087628Sdwmalone#if 0 3187628Sdwmalone#ifndef lint 3287628Sdwmalonestatic char sccsid[] = "@(#)fortran.c 8.3 (Berkeley) 4/2/94"; 3387628Sdwmalone#endif 3487628Sdwmalone#endif 3587628Sdwmalone 3687249Smarkm#include <sys/cdefs.h> 3787249Smarkm__FBSDID("$FreeBSD$"); 3887249Smarkm 391590Srgrimes#include <ctype.h> 401590Srgrimes#include <limits.h> 411590Srgrimes#include <stdio.h> 4290382Sgallatin#include <string.h> 431590Srgrimes 441590Srgrimes#include "ctags.h" 451590Srgrimes 4692920Simpstatic void takeprec(void); 471590Srgrimes 481590Srgrimeschar *lbp; /* line buffer pointer */ 491590Srgrimes 501590Srgrimesint 51201606SdwmalonePF_funcs(void) 521590Srgrimes{ 531590Srgrimes bool pfcnt; /* pascal/fortran functions found */ 541590Srgrimes char *cp; 551590Srgrimes char tok[MAXTOKEN]; 561590Srgrimes 571590Srgrimes for (pfcnt = NO;;) { 581590Srgrimes lineftell = ftell(inf); 591590Srgrimes if (!fgets(lbuf, sizeof(lbuf), inf)) 601590Srgrimes return (pfcnt); 611590Srgrimes ++lineno; 621590Srgrimes lbp = lbuf; 631590Srgrimes if (*lbp == '%') /* Ratfor escape to fortran */ 641590Srgrimes ++lbp; 651590Srgrimes for (; isspace(*lbp); ++lbp) 661590Srgrimes continue; 671590Srgrimes if (!*lbp) 681590Srgrimes continue; 691590Srgrimes switch (*lbp | ' ') { /* convert to lower-case */ 701590Srgrimes case 'c': 711590Srgrimes if (cicmp("complex") || cicmp("character")) 721590Srgrimes takeprec(); 731590Srgrimes break; 741590Srgrimes case 'd': 751590Srgrimes if (cicmp("double")) { 761590Srgrimes for (; isspace(*lbp); ++lbp) 771590Srgrimes continue; 781590Srgrimes if (!*lbp) 791590Srgrimes continue; 801590Srgrimes if (cicmp("precision")) 811590Srgrimes break; 821590Srgrimes continue; 831590Srgrimes } 841590Srgrimes break; 851590Srgrimes case 'i': 861590Srgrimes if (cicmp("integer")) 871590Srgrimes takeprec(); 881590Srgrimes break; 891590Srgrimes case 'l': 901590Srgrimes if (cicmp("logical")) 911590Srgrimes takeprec(); 921590Srgrimes break; 931590Srgrimes case 'r': 941590Srgrimes if (cicmp("real")) 951590Srgrimes takeprec(); 961590Srgrimes break; 971590Srgrimes } 981590Srgrimes for (; isspace(*lbp); ++lbp) 991590Srgrimes continue; 1001590Srgrimes if (!*lbp) 1011590Srgrimes continue; 1021590Srgrimes switch (*lbp | ' ') { 1031590Srgrimes case 'f': 1041590Srgrimes if (cicmp("function")) 1051590Srgrimes break; 1061590Srgrimes continue; 1071590Srgrimes case 'p': 1081590Srgrimes if (cicmp("program") || cicmp("procedure")) 1091590Srgrimes break; 1101590Srgrimes continue; 1111590Srgrimes case 's': 1121590Srgrimes if (cicmp("subroutine")) 1131590Srgrimes break; 1141590Srgrimes default: 1151590Srgrimes continue; 1161590Srgrimes } 1171590Srgrimes for (; isspace(*lbp); ++lbp) 1181590Srgrimes continue; 1191590Srgrimes if (!*lbp) 1201590Srgrimes continue; 1211590Srgrimes for (cp = lbp + 1; *cp && intoken(*cp); ++cp) 1221590Srgrimes continue; 123166502Srse if (cp == lbp + 1) 1241590Srgrimes continue; 1251590Srgrimes *cp = EOS; 12697574Stjr (void)strlcpy(tok, lbp, sizeof(tok)); /* possible trunc */ 1271590Srgrimes getline(); /* process line for ex(1) */ 1281590Srgrimes pfnote(tok, lineno); 1291590Srgrimes pfcnt = YES; 1301590Srgrimes } 1311590Srgrimes /*NOTREACHED*/ 1321590Srgrimes} 1331590Srgrimes 1341590Srgrimes/* 1351590Srgrimes * cicmp -- 1361590Srgrimes * do case-independent strcmp 1371590Srgrimes */ 1381590Srgrimesint 139100822Sdwmalonecicmp(const char *cp) 1401590Srgrimes{ 1411590Srgrimes int len; 1421590Srgrimes char *bp; 1431590Srgrimes 1441590Srgrimes for (len = 0, bp = lbp; *cp && (*cp &~ ' ') == (*bp++ &~ ' '); 1451590Srgrimes ++cp, ++len) 1461590Srgrimes continue; 1471590Srgrimes if (!*cp) { 1481590Srgrimes lbp += len; 1491590Srgrimes return (YES); 1501590Srgrimes } 1511590Srgrimes return (NO); 1521590Srgrimes} 1531590Srgrimes 1541590Srgrimesstatic void 155100822Sdwmalonetakeprec(void) 1561590Srgrimes{ 1571590Srgrimes for (; isspace(*lbp); ++lbp) 1581590Srgrimes continue; 1591590Srgrimes if (*lbp == '*') { 1601590Srgrimes for (++lbp; isspace(*lbp); ++lbp) 1611590Srgrimes continue; 1621590Srgrimes if (!isdigit(*lbp)) 1631590Srgrimes --lbp; /* force failure */ 1641590Srgrimes else 1651590Srgrimes while (isdigit(*++lbp)) 1661590Srgrimes continue; 1671590Srgrimes } 1681590Srgrimes} 169