fortran语法.c

语言的语法,格式严紧,对于处理yacc,lex有帮助!

发信人: InfoMagic (好好学习 天天向上), 信区: PUE 
标  题: ftn 语法 
发信站: 武汉白云黄鹤站 (2001年05月23日22:56:08 星期三), 站内信件 
  
#!/bin/sh 
# shar: Shell Archiver  (v1.22) 
# 
# Run the following text with /bin/sh to create: 
#   README 
#   makefile 
#   ftnlex.c 
#   fparse.y 
#   fmain.c 
#   ftn.h 
# 
if test -f README; then echo "File README exists"; else 
echo "x - extracting README (Text)" 
sed 's/^X//' << 'SHAR_EOF' > README && 
XThis is a Fortran 77 subset parser that I knocked together in about a 
Xweek.  It does a decent job of tokenizing and parsing Fortran, 
Xalthough it is quite incomplete.  It is provided as is without any 
Xclaim that it is suitable for any purpose nor with any promise of 
Xsupport.  Copying is permitted so long as it is not for direct 
Xcommercial advantage.  See the copyright notice in each source file. 
X 
XThe general strategy is as follows: 
X 
X 1.  Read each line, determine if it's a comment or 
X continutation. 
X 2.  If not a comment, add into the current statement buffer, 
X removing quoted literals and hollerith strings and replacing 
X them by special tokens (a space followed by a digit.) 
X 3.  Once we have an entire statement, scan it to see if it 
X looks like an assignment statement.  If not it must be a 
X keyword statement. 
X 4.  Call the yacc parser.  From this point, tokenizing is 
X pretty simple -- see if any of the keyword or special 
X character tokens that are allowed in the current context 
X match, if not look for a number or a name. Statement numbers 
X are treated as integer constants. 
X 
XThe one case where I know that I parse wrong is something like: 
X 
X real function a(34) 
X 
Xwhich dimensions the array functiona but parses incorrectly as a function 
Xdeclaration with a bogus dummy argument.  This is hard to fix and is 
unlikely 
Xto cause trouble in practice. 
X 
XThe language it parses includes some invalid constructs that would 
Xneed to be kicked out semantically, e.g.: 
X 
X dimension foo 
X 
Xbecause I treat dimension and explicit type statements the same. 
X 
XIf you want to extend this to parse more of Fortran, you'll obviously 
Xneed to add more yacc syntax (note that there is syntax in the 
Xcurrent parser that the lexer doesn't generate the tokens for,) more 
Xlexer tokens, and more lexer states.  Lexer states you'll need 
Xcertainly include: 
X 
X -- Looking for the TO in an assign statement. 
X -- Tokenizing format statements (unless you want to do 
X it at runtime, a common approach) 
X -- Looking for the zillion possible keywords in I/O 
X statements. 
X 
XThere are doubtless more, you'll know them when you see them. 
X 
XI have run this under Microsoft C 5.1 on a PC and under GCC 1.35.  It 
Xshould work on the regular unix PCC with minimal modifications, 
Xmostly getting rid of a few ANSI function prototypes that I use and 
Xperhaps adjusting the varargs constructs in emit().  It has parsed 
Xmany of the old IBM SSP routines, so I'm fairly confident that it 
Xparses what it parses pretty well. 
X 
XIf you do anything interesting with this, I'd appreciate hearing 
Xabout it. 
X 
XJohn Levine 
XP.O. Box 349 
XCambridge MA 02238 
X+1 617 492 3869 
XInternet: [e-mail] or [e-mail] 
XMCI Mail: 103-7498, WUI telex 6501037498 MCI UW 
XGenie: J.LEVINE3 
SHAR_EOF 
chmod 0644 README || echo "restore of README fails" 
fi 
if test -f makefile; then echo "File makefile exists"; else 
echo "x - extracting makefile (Text)" 
sed 's/^X//' << 'SHAR_EOF' > makefile && 
X########################################################################## 
X#     Fortran 77 Subset Parser - November 1988                           # 
X#     Copyright 1988 - John R. Levine.  All rights reserved.             # 
X#     Permission is hereby granted to make copies in modified or         # 
X#     unmodified form so long as this copyright notice is preserved      # 
X#     and such copies are not made for direct commercial advantage.      # 
X#                                                                        # 
X#     Any other use such as incorporation in whole or in part in a       # 
X#     product offered for sale requires separate permission.             # 
X#                                                                        # 
X#     John R. Levine                                                     # 
X#     P.O. Box 349                                                       # 
X#     Cambridge MA 02238-0349                                            # 
X#                                                                        # 
X#     Internet/uucp: [e-mail]    MCI Mail:  103-7498              # 
X#                                                                        # 
X########################################################################## 
X 
XCFLAGS=-g 
XCC=gcc 
XYFLAGS=-vdlt 
XOBJS=fparse.o ftnlex.o fmain.o 
X 
Xftn: $(OBJS) 
X ${CC} $(CFLAGS) -o $@ $(OBJS) 
X 
Xfparse.o: fparse.c ftn.h 
X 
Xfparse.c fparse.h: fparse.y 
X  yacc $(YFLAGS) fparse.y 
X  mv y.tab.c fparse.c 
X  mv y.tab.h fparse.h 
X 
Xftnlex.o: ftnlex.c fparse.h ftn.h 
X 
Xfmain.o: fmain.c fparse.h ftn.h 
X 
X#%.o: %.c 
X# ${CC} -c ${CFLAGS} $< 
SHAR_EOF 
chmod 0644 makefile || echo "restore of makefile fails" 
fi 
if test -f ftnlex.c; then echo "File ftnlex.c exists"; else 
echo "x - extracting ftnlex.c (Text)" 
sed 's/^X//' << 'SHAR_EOF' > ftnlex.c && 
X/************************************************************************* 
X*                                                                        * 
X*     Fortran 77 Subset Parser - November 1988                           * 
X*     Copyright 1988 - John R. Levine.  All rights reserved.             * 
X*     Permission is hereby granted to make copies in modified or         * 
X*     unmodified form so long as this copyright notice is preserved      * 
X*     and such copies are not made for direct commercial advantage.      * 
X*                                                                        * 
X*     Any other use such as incorporation in whole or in part in a       * 
X*     product offered for sale requires separate permission.             * 
X*                                                                        * 
X*     John R. Levine                                                     * 
X*     P.O. Box 349                                                       * 
X*     Cambridge MA 02238-0349                                            * 
X*                                                                        * 
X*     Internet/uucp: [e-mail]    MCI Mail:  103-7498              * 
X*                                                                        * 
X*************************************************************************/ 
X 
X#include "ftn.h" 
X#include "fparse.h" 
X#include <ctype.h> 
X#include <malloc.h> 
X#include <stdio.h> 
X#include <string.h> 
X 
Xextern FILE *ifile; 
X 
Xchar stmtbuf[1321]; /* buffer a whole statement */ 
Xchar linebuf[100]; /* buffer a line at a time */ 
Xchar *lbcp;  /* start of text in linebuf; */ 
Xchar *scp;  /* current location in stmtbuf */ 
X 
Xlong next_stno = -1; /* statement number for next statement, from pre */ 
Xint lineno = 0; 
Xenum contexts context; 
X 
X/* first, we read in a statement */ 
X 
X/* After each statement is read, the read pointer is at the 
X   first line of the next statement because we needed to peek ahead and 
X   see if there was a continuation card. 
X*/ 
X 
X/* this reads a line, then looks to see if it's a continuation, and if 
X   not if there's a statement number. 
X   return values: -1 at EOF, 0 for first line, 1 for continuation */ 
X 
Xint 
Xrdstno() 
X{ 
X int flg; 
X int colno; 
X 
X for(;;) { 
X  register char *cp; 
X 
X  if(!fgets(linebuf, sizeof(linebuf), ifile)) 
X   return -1; /* EOF */ 
X  lineno++; 
X  if(linebuf[0] == 'C' || linebuf[0] == 'c' 
X   || linebuf[0] == '*') 
X   continue; /* comment */ 
X  /* check for totally blank line */ 
X  /* and trim at column 72 */ 
X  flg = 0; 
X  for(cp = linebuf, colno = 1; *cp; cp++, colno++) { 
X   if(*cp == '\n') { 
X    *cp = 0; 
X    break; 
X   } 
X   if(*cp == '\t' && colno < 5) 
X    colno = 5; /* tab ahead */ 
X   else if(*cp != ' ' && *cp != '\t') 
X    flg = 1; 
X   if(colno == 72) { 
X    cp[1] = 0; /* white out seq cols */ 
X    break; 
X   } 
X  } 
X  if(!flg) 
X   continue; /* blank line comment */ 
X  /* now, get the line number and comment flag */ 
X  next_stno = 0; 
X  colno = 0; 
X  for(cp = linebuf; colno < 6; cp++, colno++) { 
X   if(isdigit(*cp)) 
X    next_stno = 10*next_stno + *cp-'0'; 
X   else if(*cp == '\t') 
X    colno = 5; 
X   else if(*cp != ' ') 
X    yyerror("Bad stmt label"); 
X  } 
X  lbcp = cp; 
X  cp--;   /* point at continuation marker */ 
X  return(*cp != ' ' && *cp != '\t' && *cp != '0'); 
X } 
X} /* rdstno */ 
X 
Xint stmt_eof; 
X 
X/* at prescan time quoted strings are pulled out and stashed here */ 
X/* in the scanned statement, the literal string is replaced by a quote 
X   and a digit indicating which table entry it is */ 
X 
Xchar *string_tab[30];    /* quoted strings */ 
Xchar **string_tabp = string_tab; 
X 
X/* read and prescan a statement, pull out literal strings and squeeze out 
X   blanks. 
X   return 1 if statement read, 0 at eof */ 
X 
Xint 
Xrdstmt() 
X{ 
X char *cp; 
X int c; 
X int colno; 
X int quoteflag = 0; /* >0 means 3hfoo, -1 means 'foo' */ 
X int quotable = 0;       /* 1 if nnH allowed */ 
X char *quotep, *quotelim; 
X 
X /* make sure there's a line ready for us */ 
X if(next_stno < 0) 
X  stmt_eof = rdstno(); 
X 
X if(stmt_eof < 0) 
X  return 0; 
X 
X /* at this point we might want to do something about the statement 
X    number */ 
X 
X /* now read and process lines until we find one that isn't a 
X    continuation */ 
X 
X cp = stmtbuf; 
X do { 
X  char *icp; 
X 
X  for(icp = lbcp; *icp; icp++) { 
X 
X   c = *icp; 
X   /* process a card image */ 
X   /* special case for literal strings, keep blanks */ 
X   if(quoteflag) { 
X    if(quoteflag < 0 && c == '\'') { 
X     if(icp[1] != '\'') { 
X      *quotep = 0; 
X      string_tabp++; 
X      quoteflag = 0; 
X      continue; 
X     } else 
X      icp++; 
X    } 
X 
X    if(quotep >= quotelim) 
X     yyerror("String too long"); 
X    else 
X     *quotep++ = (char)c; 
X    if(quoteflag > 0) 
X     quoteflag--; 
X    if(quoteflag == 0) { 
X     *quotep = 0; 
X     string_tabp++; 
X     quoteflag = 0; 
X    } 
X    continue; 
X   } 
X   /* discard unquoted spaces */ 
X   if(c == ' ' || c == '\t') 
X    continue; 
X 
X   c = toupper(c); 
X   /* literal strings can only occur after (  = or / */ 
X   /* consider  REAL*4HELLO */ 
X   if(!quotable && (c == '=' || c == '/' || c == '(')) 
X    quotable++; /* could have string */ 
X 
X   /* check for quoted literal */ 
X   if(c == '\'') { 
X    quoteflag = -1; 
X    *string_tabp = quotep = malloc(80); 
X    quotelim = quotep + 79; 
X    *cp++ = '\''; /* string flag */ 
X    *cp++ = '0' 
X      + (string_tabp - string_tab); 
X    continue; 
X   } 
X   *cp = (char)c; 
X   /* check for counted (hollerith) literal */ 
X   if(c == 'H' && quotable 
X    && cp > stmtbuf && isdigit(cp[-1])) { 
X    char *tcp = cp-1; 
X 
X    while(tcp > stmtbuf && isdigit(*tcp)) 
X     tcp--; 
X    if(!isalnum(*tcp)) { /* yes */ 
X     tcp++; 
X     cp = tcp; /* back over digs */ 
X     quoteflag = 0; 
X     while(*tcp != 'H') 
X      quoteflag = quoteflag*10 
X       + *tcp++ - '0'; 
X 
X     *string_tabp = quotep 
X      = malloc(quoteflag+1); 
X     quotelim = quotep + quoteflag + 1; 
X     *cp++ = '\''; /* string flag */ 
X     *cp++ = '0' 
X       + (string_tabp - string_tab); 
X     continue; 
X    } 
X   } 
X   cp++; 
X  } /* single line */ 
X } while((stmt_eof = rdstno()) == 1); 
X if(quoteflag) { 
X  *quotep = 0; 
X  yyerror("Unterminated string"); 
X } 
X *cp = 0; 
X return 1;       /* found something */ 
X} /* rdstmt */ 
X 
X/* prescan to see if this is an arithmetic statement */ 
X/* returns 1 if it's an arithmetic stmt, 0 if not */ 
X/* this hack involves looking for an equal sign not enclosed in parens 
X   and not followed by a comma not enclosed in parens.  Gross but 
effective. 
X */ 
X 
Xprescan() 
X{ 
X register char *cp; 
X int parencount = 0; 
X 
X /* scan across counting parens and looking for an = */ 
X for(cp = scp; ; cp++) { 
X  switch(*cp) { 
X case 0:  return 0; /* no equal found */ 
X 
X case '(': parencount++; 
X   continue; 
X 
X case ')': if(--parencount == 0) /* foo(a,...) = ... */ 
X    if(cp[1] == '=') 
X     break; 
X    else 
X     return 0; /* if(foo)... */ 
X   continue; 
X 
X case '=': if(parencount == 0) 
X    break; 
X default: 
X   continue;       /* ignore anything else */ 
X  } 
X  break; 
X } 
X 
X /* found an equal, but might be a DO statement */ 
X /* now look for the comma which tells us it might be a DO loop */ 
X for(;;cp++) { 
X  switch(*cp) { 
X case '(': parencount++; break; 
X case ')': parencount--; break; 
X case ',': if(!parencount) 
X    return 0; 
X   break; 
X case 0:  return 1; /* it's an arith statement */ 
X  } /* switch */ 
X } /* for */ 
X} /* prescan */ 
X 
X 
X/* keyword tables */ 
X 
X/* statement starting keywords */ 
Xkwdtab tab_stmt[] = { 
X { "CALL", CALL, 0 }, 
X { "COMMON", COMMON, 0 }, 
X { "CONTINUE", CONTINUE, 0 }, 
X { "DATA", DATA, 0 }, 
X { "DIMENSION", DIMENSION, 0 }, 
X { "DO",  DO, 0 },