forlex.c

这是一个Linux下的集成开发环境

/*

Copyright (c) 2000, Red Hat, Inc.

This file is part of Source-Navigator.

Source-Navigator is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your option)
any later version.

Source-Navigator is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License along
with Source-Navigator; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.



*/

/* forlex.c:

	Tokenizing routines for Fortran program checker.

This version implements blank-insensitivity.

    Copyright (C) 1993 by Robert K. Moniot.
    This program is free software.  Permission is granted to
    modify it and/or redistribute it, retaining this notice.
    No guarantees accompany this software.


 Part I. yylex()  -- gives tokens to the parser.
 Part II. advance() -- bottom-level scanning of input stream.

*/

#define CASE_SENSITIVE


	/* Declarations shared by all modules */

#include <stdio.h>
#include <ctype.h>
#include <string.h>
#if defined (__MSVC__) || defined(__STDC__) || defined(__osf__)
#include <stdlib.h>
#else
char *getenv();
#endif

#include <tcl.h>

#include "ftnchek.h"
#define FORLEX
#include "symtab.h"
#include "fortran.h"
#include "sn.h"

int max_line_width = 0;

extern FILE *hig_fp;
extern int	highlight;
extern Tcl_Encoding encoding;

/* lexdefs.h:
		Macros and shared info for lexical analysis routines
*/

#define LEX_SHARED PRIVATE

#define EOL     '\n'    /* Character for end of line, not of statement */

extern YYSTYPE yylval;	  /* Lexical value for Yacc */


	/* Since EOS is special, need special macros for it */
#define makeupper(C) (((C) != EOS && islower((int)(C)))? toupper((int)(C)):(C))
#define iswhitespace(C) ( (C) != EOS && isspace((int)(C)) )
#define isadigit(C)     ( (C) != EOS && isdigit((int)(C)) )
#define isaletter(C)    ( (C) != EOS && isalpha((int)(C)) )
#define ishex(C) ((C) != EOS && (isdigit((int)(C)) ||\
			(toupper((int)(C))>='A' && toupper((int)(C))<='F') ))

	/* define isidletter to allow underscore and/or dollar sign or not */
				/* both underscore and dollar sign */
#define isidletter(C)    ( (C) != EOS && (isalpha((int)(C)) || \
					  (C) == '_' || (C) == '$' ) )

#define BCD(C) ((C)-'0')	/* Binary value of digit */
#define HEX(C) (isdigit(C)?BCD(C):(makeupper(C)-'A'+10)) /* Hex value */

				/* Blank-insensitive advance */
#define bi_advance()	do {advance();} while(iswhitespace(curr_char))

#define bi_advanceX()	{ do {advance(); i_white++; } while(iswhitespace(curr_char)); }

LEX_SHARED int
	inside_string,		/* TRUE when reading a string or hollerith */
	inside_hollerith,	/* TRUE when reading a hollerith */
	WHILE_expected,		/* DO seen and WHILE is coming up */
	contin_count,		/* Number of continuation lines of stmt */
  	prev_char,		/* shared between forlex.c and advance.c */
	curr_char,		/* Current input character */
	next_char;		/* Lookahead character */

#ifdef UNIX_CPP
LEX_SHARED char
	*next_filename;
LEX_SHARED int
	cpp_handled;
#endif

PRIVATE char acSymbol[1000];
PRIVATE int Symbol_line_num;
PRIVATE int Symbol_col_num;
PRIVATE int Symbol_curr_index;
PRIVATE char acCppInclude[1000];

extern int complex_const_allowed,    /* shared flags operated by fortran.y */
	   inside_format,
	   integer_context;
extern int stmt_sequence_no;	/* shared with fortran.y */

		/* Declare shared lexical routines */
LEX_SHARED
void advance();
LEX_SHARED
int is_keyword(), looking_at_cplx(), looking_at_keywd(), looking_at_relop();

#ifdef DEBUG_INCLUDE
LEX_SHARED
int debug_include=FALSE;
#endif


/*

Part I. yylex()

   Shared functions defined:
	yylex()			Returns next token.  Called from yyparse().
	implied_id_token(t,s)	Creates token for blank common declaration.

Note: compilation options LEX_STORE_STRINGS and LEX_STORE_HOLLERITHS:
  Define the macro name LEX_STORE_STRINGS to build a version of ftnchek that
  stores string constants, and LEX_STORE_HOLLERITHS to store hollerith
  constants.  Now that INCLUDE statements are supported, strings must
  be stored.  Holleriths are not used, so they need not be stored.
*/
#define LEX_STORE_STRINGS

#ifdef DEVELOPMENT		/* For maintaining the program */
abc
#define LEX_STORE_HOLLERITHS
#define DEBUG_FORLEX
#endif

#include <math.h>



	/* The following macro says whether a given character is legal,
	 * i.e. one of the stream control chars or a valid ANSI Fortran
	 * character.  Lower case letters are considered legal too.
	 * Nondigits in columns 1-6 (except EOF,EOS) are illegal.
	 * Hopefully this works for EBCDIC too.
	 */
#define islegal(C) ( ((C) == EOF) || ((C) == EOS) || \
	( (col_num >= 6 || isdigit(C)) && \
	 ((C) >= ' ' && (C) <= 'z' && \
	  legal_chars[toascii((int)(C))-toascii(' ')] == (C))) )

		/* Array has x where ASCII character is not valid */
PRIVATE char legal_chars[]=
" x\"x$xx'()*+,-./0123456789:x<=>xx\
ABCDEFGHIJKLMNOPQRSTUVWXYZxxxx_xabcdefghijklmnopqrstuvwxyz";

PRIVATE int
#if 0
	curr_index,		/* Index in line of curr_char */
#endif
	next_index;		/* Index in line of next_char */

		/* local functions defined */
PRIVATE void
#ifdef UNIX_CPP
	get_cpp_directive(),
#endif
	get_dot(), get_dotted_keyword(), get_edit_descriptor(), get_hollerith(),
	get_identifier(), get_illegal_token(), get_label(),
	get_letter(), get_number(), get_punctuation(),
	get_simple_punctuation(), get_string(),
#ifdef TYPELESS_CONSTANTS
get_binary_const(),
#endif
	get_complex_const();

static void save_comment(char *filename, char *func, char *classn, int line_num, int col_num, char *acComment);

PRIVATE void
	closeup();


		/*  Gets next token for Yacc.  Return value is token.class,
		 *  and a copy of the token is stored in yylval.
		 */
int
yylex()
{
    Token token;

	token.next_token = 0;
	token.dot_token  = 0;

	if( acCppInclude[0] )
	{
		char acFilename[1000];

		strcpy( acFilename, acCppInclude );
		acCppInclude[0] = 0;
    	open_include_file( SN_StrDup( acFilename ));
	}

	if( acSymbol[0] )
	{
		int h;
		Lsymtab *symt;

/* 		printf( "acSymbol: <%s> %d %d\n", acSymbol, Symbol_line_num, Symbol_col_num ); */
    	token.subclass = 0;
	    token.line_num = Symbol_line_num;
	    token.col_num = Symbol_col_num;
	    token.curr_index = Symbol_curr_index;
		token.class = tok_identifier;
		token.value.integer = h = hash_lookup(acSymbol);
		if((symt=hashtab[h].loc_symtab) != NULL && symt->array_var) {
		      token.class = tok_array_identifier;
		}
		acSymbol[0] = 0;
        yylval = token;
        return token.class;
	}

		/* Initialize token fields to scratch. */
    token.subclass = 0;
    token.value.integer = 0;

    if(curr_char == EOF) {
	token.class = EOF;
	token.line_num = line_num;
	token.col_num = col_num;
	token.curr_index = curr_index;
    }
    else /* not EOF */ {


		/* Skip leading spaces, and give error message if non-ANSI
		 * characters are found.
		 */

	while(iswhitespace(curr_char) || (! islegal(curr_char))  ) {
	  if(!iswhitespace(curr_char)) {
#ifdef UNIX_CPP
	    if(curr_char == '#' && col_num == 1) {
	       get_cpp_directive();	/* turn # line into EOS */
	       break;
	    }
	    else
#endif
		yyerror("Illegal character");
	  }
	  advance();
	}

	token.line_num = line_num;
	token.col_num = col_num;
	token.curr_index = curr_index;

	if(inside_format) {	/* Handle format stuff here to avoid trouble */
	  get_edit_descriptor(&token);
	}
	else if(isadigit(curr_char)) {
		if(col_num < 6)
			get_label(&token);      /* Stmt label */
		else
			get_number(&token);     /* Numeric or hollerith const */
	}
	else if(isidletter(curr_char)) {
		if(implicit_letter_flag)
			get_letter(&token);	/* letter in IMPLICIT list */
		else
			get_identifier(&token); /* Identifier or keyword */
	}
	else if(curr_char == '\'' || curr_char == '"') {
			get_string(&token);	/* Quoted string */
	}
	else if(curr_char == '.') {
			get_dot(&token);	 /* '.' lead-in */
	}
	else {
			get_punctuation(&token);  /* Punctuation character or EOS */
	}
    }/*end not EOF*/

    if(token.class == EOS) {
	implicit_flag=FALSE;	/* in case of errors, reset flags */
	implicit_letter_flag = FALSE;
    }


    prev_token_class = token.class;

    yylval = token;

/* 	printf( "Token: %d\n", token.class ); */
    return token.class;

} /* yylex */



	/* Fills argument with token for an identifer, as if an identifer
	 * with name given by string s had been lexed.  This will
	 * be called by parser when blank common declaration is seen,
	 * and when a main prog without program statement is found,
	 * and when an unnamed block data statement is found,
	 * so processing of named and unnamed cases can be handled uniformly.
	*/
void
implied_id_token(t,s)
	Token *t;
	char *s;
{
	int h;
	unsigned long hnum;

	hnum = hash(s);
	while( h=hnum%HASHSZ, hashtab[h].name != NULL &&
		strcmp(hashtab[h].name,s) != 0)
			hnum = rehash(hnum);
	if(hashtab[h].name == NULL) {	/* not seen before */
		hashtab[h].name = s;
		hashtab[h].loc_symtab = NULL;
		hashtab[h].glob_symtab = NULL;
		hashtab[h].com_loc_symtab = NULL;
		hashtab[h].com_glob_symtab = NULL;
	}
	t->class = tok_identifier;
	t->value.integer = h;

} /* implied_id_token */

#ifdef UNIX_CPP
		/* This does not create a token but just performs the
		   actions needed when a cpp directive is seen.  It
		   advances curr_char to the EOS.  The setting of
		   filename is delayed to this point because it is not
		   stored in tokens but is external, so changing it
		   must wait till the previous statement is fully
		   parsed and any error messages printed and arg or
		   com list headers completed.
		 */
#ifdef rigo
PRIVATE void
get_cpp_directive()
{
  if(next_filename != (char *)NULL) {
    current_filename = next_filename;
    if(incdepth == 0)
      top_filename = next_filename;
  }
  do {			/* Skip to end of directive.  It will become an EOS */
    advance();
  } while( curr_char != EOS);

  if(f77_standard || !cpp_handled) {
    nonstandard(line_num,col_num);
    msg_tail(": preprocessor directive");
    if(!cpp_handled)
      msg_tail("(not processed)");
  }
}/*get_cpp_directive*/
#endif

static void get_cpp_directive()
{
    char ac[1000];
    char *pc;
    char *pcFilename;
    char *pcDefinename;
    int my_line_num;

    if( next_filename != (char *)NULL )
    {
        current_filename = next_filename;
        if( incdepth == 0 )
        {
            top_filename = next_filename;
        }
    }

    pc = ac;
    my_line_num = line_num;

    do
    {                  /* Skip to end of directive.  It will become an EOS */
        advance();
        *pc++ = curr_char;
    } while( curr_char != EOS);

    pc[-1] = 0;

    for( pc = ac; *pc; pc++ )
    {
        if( ! isspace( *pc )) break;
    }

    if( strncmp( pc, "include", 7 ) == 0 )
    {
	    if( hig_fp )
	    {
		    if( strcmp( current_filename, top_filename ) == 0 )
		    {
			    fprintf( hig_fp, "%d key %d.%d %d.%d\n"
				       , PAF_HIGH
				       , my_line_num
				       , 0
				       , my_line_num
				       , pc - ac + 8
				       ); 
		    }
	    }

        pcFilename = 0;

        for( ; *pc; pc++ )
        {
            if( *pc == '"' || *pc == '<' )
            {
                pcFilename = pc+1;
                break;
            }
        }

        if( pcFilename )
        {
            for( pc = pcFilename; *pc; pc++ )
            {
                if( *pc == '"' || *pc == '>' )
                {
                   *pc = 0;
                   break;
                }
            }
			strcpy( acCppInclude, pcFilename );
        }
    }
    else if( strncmp( pc, "define", 6 ) == 0 )
    {
	int my_index;

	if( hig_fp )
	{
	    if( strcmp( current_filename, top_filename ) == 0 )
	    {
		    fprintf( hig_fp, "%d key %d.%d %d.%d\n"
			       , PAF_HIGH
			       , my_line_num
			       , 0
			       , my_line_num
			       , pc - ac + 7
			       ); 
	    }
	}

        pcDefinename = 0;
	pc += 6;

        for( ; *pc; pc++)
        {
	    if( ! iswhitespace( *pc ))
            {
                pcDefinename = pc;
                break;
            }
        }
	my_index = pc - ac + 1;

        if( pcDefinename )
        {
            for( pc = pcDefinename; *pc; pc++ )
            {
#ifndef CASE_SENSITIVE
				*pc = makeupper( *pc );
#endif
				if( iswhitespace( *pc ) || *pc == '(' )
                {
                   *pc = 0;
                   break;
                }
            }

				/* Identifier: find its hashtable entry or
				   create a new entry.	*/
			{
		    	int h;

		    	h = hash_lookup(pcDefinename);
		        hashtab[h].define = 1;
				if( highlight != -1 )
				{
					put_symbol(PAF_CONS_DEF,NULL,pcDefinename,
						current_filename,
						my_line_num,
						my_index,
						0,0,
						(long)0,NULL,NULL,NULL,