fortran.c revision 201606
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 * 3. All advertising materials mentioning features or use of this software 141590Srgrimes * must display the following acknowledgement: 151590Srgrimes * This product includes software developed by the University of 161590Srgrimes * California, Berkeley and its contributors. 171590Srgrimes * 4. Neither the name of the University nor the names of its contributors 181590Srgrimes * may be used to endorse or promote products derived from this software 191590Srgrimes * without specific prior written permission. 201590Srgrimes * 211590Srgrimes * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 221590Srgrimes * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 231590Srgrimes * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 241590Srgrimes * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 251590Srgrimes * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 261590Srgrimes * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 271590Srgrimes * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 281590Srgrimes * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 291590Srgrimes * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 301590Srgrimes * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 311590Srgrimes * SUCH DAMAGE. 321590Srgrimes */ 331590Srgrimes 3487628Sdwmalone#if 0 3587628Sdwmalone#ifndef lint 3687628Sdwmalonestatic char sccsid[] = "@(#)fortran.c 8.3 (Berkeley) 4/2/94"; 3787628Sdwmalone#endif 3887628Sdwmalone#endif 3987628Sdwmalone 4087249Smarkm#include <sys/cdefs.h> 4187249Smarkm__FBSDID("$FreeBSD: head/usr.bin/ctags/fortran.c 201606 2010-01-05 20:32:08Z dwmalone $"); 4287249Smarkm 431590Srgrimes#include <ctype.h> 441590Srgrimes#include <limits.h> 451590Srgrimes#include <stdio.h> 4690382Sgallatin#include <string.h> 471590Srgrimes 481590Srgrimes#include "ctags.h" 491590Srgrimes 5092920Simpstatic void takeprec(void); 511590Srgrimes 521590Srgrimeschar *lbp; /* line buffer pointer */ 531590Srgrimes 541590Srgrimesint 55201606SdwmalonePF_funcs(void) 561590Srgrimes{ 571590Srgrimes bool pfcnt; /* pascal/fortran functions found */ 581590Srgrimes char *cp; 591590Srgrimes char tok[MAXTOKEN]; 601590Srgrimes 611590Srgrimes for (pfcnt = NO;;) { 621590Srgrimes lineftell = ftell(inf); 631590Srgrimes if (!fgets(lbuf, sizeof(lbuf), inf)) 641590Srgrimes return (pfcnt); 651590Srgrimes ++lineno; 661590Srgrimes lbp = lbuf; 671590Srgrimes if (*lbp == '%') /* Ratfor escape to fortran */ 681590Srgrimes ++lbp; 691590Srgrimes for (; isspace(*lbp); ++lbp) 701590Srgrimes continue; 711590Srgrimes if (!*lbp) 721590Srgrimes continue; 731590Srgrimes switch (*lbp | ' ') { /* convert to lower-case */ 741590Srgrimes case 'c': 751590Srgrimes if (cicmp("complex") || cicmp("character")) 761590Srgrimes takeprec(); 771590Srgrimes break; 781590Srgrimes case 'd': 791590Srgrimes if (cicmp("double")) { 801590Srgrimes for (; isspace(*lbp); ++lbp) 811590Srgrimes continue; 821590Srgrimes if (!*lbp) 831590Srgrimes continue; 841590Srgrimes if (cicmp("precision")) 851590Srgrimes break; 861590Srgrimes continue; 871590Srgrimes } 881590Srgrimes break; 891590Srgrimes case 'i': 901590Srgrimes if (cicmp("integer")) 911590Srgrimes takeprec(); 921590Srgrimes break; 931590Srgrimes case 'l': 941590Srgrimes if (cicmp("logical")) 951590Srgrimes takeprec(); 961590Srgrimes break; 971590Srgrimes case 'r': 981590Srgrimes if (cicmp("real")) 991590Srgrimes takeprec(); 1001590Srgrimes break; 1011590Srgrimes } 1021590Srgrimes for (; isspace(*lbp); ++lbp) 1031590Srgrimes continue; 1041590Srgrimes if (!*lbp) 1051590Srgrimes continue; 1061590Srgrimes switch (*lbp | ' ') { 1071590Srgrimes case 'f': 1081590Srgrimes if (cicmp("function")) 1091590Srgrimes break; 1101590Srgrimes continue; 1111590Srgrimes case 'p': 1121590Srgrimes if (cicmp("program") || cicmp("procedure")) 1131590Srgrimes break; 1141590Srgrimes continue; 1151590Srgrimes case 's': 1161590Srgrimes if (cicmp("subroutine")) 1171590Srgrimes break; 1181590Srgrimes default: 1191590Srgrimes continue; 1201590Srgrimes } 1211590Srgrimes for (; isspace(*lbp); ++lbp) 1221590Srgrimes continue; 1231590Srgrimes if (!*lbp) 1241590Srgrimes continue; 1251590Srgrimes for (cp = lbp + 1; *cp && intoken(*cp); ++cp) 1261590Srgrimes continue; 127166502Srse if (cp == lbp + 1) 1281590Srgrimes continue; 1291590Srgrimes *cp = EOS; 13097574Stjr (void)strlcpy(tok, lbp, sizeof(tok)); /* possible trunc */ 1311590Srgrimes getline(); /* process line for ex(1) */ 1321590Srgrimes pfnote(tok, lineno); 1331590Srgrimes pfcnt = YES; 1341590Srgrimes } 1351590Srgrimes /*NOTREACHED*/ 1361590Srgrimes} 1371590Srgrimes 1381590Srgrimes/* 1391590Srgrimes * cicmp -- 1401590Srgrimes * do case-independent strcmp 1411590Srgrimes */ 1421590Srgrimesint 143100822Sdwmalonecicmp(const char *cp) 1441590Srgrimes{ 1451590Srgrimes int len; 1461590Srgrimes char *bp; 1471590Srgrimes 1481590Srgrimes for (len = 0, bp = lbp; *cp && (*cp &~ ' ') == (*bp++ &~ ' '); 1491590Srgrimes ++cp, ++len) 1501590Srgrimes continue; 1511590Srgrimes if (!*cp) { 1521590Srgrimes lbp += len; 1531590Srgrimes return (YES); 1541590Srgrimes } 1551590Srgrimes return (NO); 1561590Srgrimes} 1571590Srgrimes 1581590Srgrimesstatic void 159100822Sdwmalonetakeprec(void) 1601590Srgrimes{ 1611590Srgrimes for (; isspace(*lbp); ++lbp) 1621590Srgrimes continue; 1631590Srgrimes if (*lbp == '*') { 1641590Srgrimes for (++lbp; isspace(*lbp); ++lbp) 1651590Srgrimes continue; 1661590Srgrimes if (!isdigit(*lbp)) 1671590Srgrimes --lbp; /* force failure */ 1681590Srgrimes else 1691590Srgrimes while (isdigit(*++lbp)) 1701590Srgrimes continue; 1711590Srgrimes } 1721590Srgrimes} 173