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