fortran.c revision 87249
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 3487249Smarkm#include <sys/cdefs.h> 3587249Smarkm 3687249Smarkm__FBSDID("$FreeBSD: head/usr.bin/ctags/fortran.c 87249 2001-12-03 00:07:59Z markm $"); 3787249Smarkm 381590Srgrimes#ifndef lint 3941568Sarchiestatic const char sccsid[] = "@(#)fortran.c 8.3 (Berkeley) 4/2/94"; 4081782Smikeh#endif 411590Srgrimes 421590Srgrimes#include <ctype.h> 431590Srgrimes#include <limits.h> 441590Srgrimes#include <stdio.h> 451590Srgrimes#include <string.h> 461590Srgrimes 471590Srgrimes#include "ctags.h" 481590Srgrimes 491590Srgrimesstatic void takeprec __P((void)); 501590Srgrimes 511590Srgrimeschar *lbp; /* line buffer pointer */ 521590Srgrimes 531590Srgrimesint 541590SrgrimesPF_funcs() 551590Srgrimes{ 561590Srgrimes bool pfcnt; /* pascal/fortran functions found */ 571590Srgrimes char *cp; 581590Srgrimes char tok[MAXTOKEN]; 591590Srgrimes 601590Srgrimes for (pfcnt = NO;;) { 611590Srgrimes lineftell = ftell(inf); 621590Srgrimes if (!fgets(lbuf, sizeof(lbuf), inf)) 631590Srgrimes return (pfcnt); 641590Srgrimes ++lineno; 651590Srgrimes lbp = lbuf; 661590Srgrimes if (*lbp == '%') /* Ratfor escape to fortran */ 671590Srgrimes ++lbp; 681590Srgrimes for (; isspace(*lbp); ++lbp) 691590Srgrimes continue; 701590Srgrimes if (!*lbp) 711590Srgrimes continue; 721590Srgrimes switch (*lbp | ' ') { /* convert to lower-case */ 731590Srgrimes case 'c': 741590Srgrimes if (cicmp("complex") || cicmp("character")) 751590Srgrimes takeprec(); 761590Srgrimes break; 771590Srgrimes case 'd': 781590Srgrimes if (cicmp("double")) { 791590Srgrimes for (; isspace(*lbp); ++lbp) 801590Srgrimes continue; 811590Srgrimes if (!*lbp) 821590Srgrimes continue; 831590Srgrimes if (cicmp("precision")) 841590Srgrimes break; 851590Srgrimes continue; 861590Srgrimes } 871590Srgrimes break; 881590Srgrimes case 'i': 891590Srgrimes if (cicmp("integer")) 901590Srgrimes takeprec(); 911590Srgrimes break; 921590Srgrimes case 'l': 931590Srgrimes if (cicmp("logical")) 941590Srgrimes takeprec(); 951590Srgrimes break; 961590Srgrimes case 'r': 971590Srgrimes if (cicmp("real")) 981590Srgrimes takeprec(); 991590Srgrimes break; 1001590Srgrimes } 1011590Srgrimes for (; isspace(*lbp); ++lbp) 1021590Srgrimes continue; 1031590Srgrimes if (!*lbp) 1041590Srgrimes continue; 1051590Srgrimes switch (*lbp | ' ') { 1061590Srgrimes case 'f': 1071590Srgrimes if (cicmp("function")) 1081590Srgrimes break; 1091590Srgrimes continue; 1101590Srgrimes case 'p': 1111590Srgrimes if (cicmp("program") || cicmp("procedure")) 1121590Srgrimes break; 1131590Srgrimes continue; 1141590Srgrimes case 's': 1151590Srgrimes if (cicmp("subroutine")) 1161590Srgrimes break; 1171590Srgrimes default: 1181590Srgrimes continue; 1191590Srgrimes } 1201590Srgrimes for (; isspace(*lbp); ++lbp) 1211590Srgrimes continue; 1221590Srgrimes if (!*lbp) 1231590Srgrimes continue; 1241590Srgrimes for (cp = lbp + 1; *cp && intoken(*cp); ++cp) 1251590Srgrimes continue; 12632069Salex if ((cp = lbp + 1)) 1271590Srgrimes continue; 1281590Srgrimes *cp = EOS; 1291590Srgrimes (void)strcpy(tok, lbp); 1301590Srgrimes getline(); /* process line for ex(1) */ 1311590Srgrimes pfnote(tok, lineno); 1321590Srgrimes pfcnt = YES; 1331590Srgrimes } 1341590Srgrimes /*NOTREACHED*/ 1351590Srgrimes} 1361590Srgrimes 1371590Srgrimes/* 1381590Srgrimes * cicmp -- 1391590Srgrimes * do case-independent strcmp 1401590Srgrimes */ 1411590Srgrimesint 1421590Srgrimescicmp(cp) 14387215Smarkm 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 1591590Srgrimestakeprec() 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