fortran.c

ctags-5.5.4.tar.gz,一个很好的代码开发以及编辑源码

	     * character blank.
	     */
	    if (c == ' '  ||  c == '0')
		type = LTYPE_INITIAL;

	    /* 3.2.3  Continuation_Line.  A continuation line is any line that
	     * contains any character of the FORTRAN character set other than
	     * the character blank or the digit 0 in column 6 and contains
	     * only blank characters in columns 1 through 5.
	     */
	    else if (vStringLength (label) == 0)
		type = LTYPE_CONTINUATION;
	    else
		type = LTYPE_INVALID;
	}
	else if (c == ' ')
	    ;
	else if (c == EOF)
	    type = LTYPE_EOF;
	else if (c == '\n')
	    type = LTYPE_SHORT;
	else if (isdigit (c))
	    vStringPut (label, c);
	else
	    type = LTYPE_INVALID;

	++column;
    } while (column < 6  &&  type == LTYPE_UNDETERMINED);

    Assert (type != LTYPE_UNDETERMINED);

    if (vStringLength (label) > 0)
    {
	vStringTerminate (label);
	makeLabelTag (label);
	vStringClear (label);
    }
    return type;
}

static int getFixedFormChar (void)
{
    boolean newline = FALSE;
    lineType type;
    int c = '\0';

    if (Column > 0)
    {
#ifdef STRICT_FIXED_FORM
	/*  EXCEPTION! Some compilers permit more than 72 characters per line.
	 */
	if (Column > 71)
	    c = skipLine ();
	else
#endif
	{
	    c = fileGetc ();
	    ++Column;
	}
	if (c == '\n')
	{
	    newline = TRUE;	/* need to check for continuation line */
	    Column = 0;
	}
	else if (c == '!'  &&  ! ParsingString)
	{
	    c = skipLine ();
	    newline = TRUE;	/* need to check for continuation line */
	    Column = 0;
	}
	else if (c == '&')	/* check for free source form */
	{
	    const int c2 = fileGetc ();
	    if (c2 == '\n')
		longjmp (Exception, (int) ExceptionFixedFormat);
	    else
		fileUngetc (c2);
	}
    }
    while (Column == 0)
    {
	type = getLineType ();
	switch (type)
	{
	    case LTYPE_UNDETERMINED:
	    case LTYPE_INVALID:
		longjmp (Exception, (int) ExceptionFixedFormat);
		break;

	    case LTYPE_SHORT: break;
	    case LTYPE_COMMENT: skipLine (); break;

	    case LTYPE_EOF:
		Column = 6;
		if (newline)
		    c = '\n';
		else
		    c = EOF;
		break;

	    case LTYPE_INITIAL:
		if (newline)
		{
		    c = '\n';
		    Column = 6;
		    break;
		}
		/* fall through to next case */
	    case LTYPE_CONTINUATION:
		Column = 5;
		do
		{
		    c = fileGetc ();
		    ++Column;
		} while (isBlank (c));
		if (c == '\n')
		    Column = 0;
		else if (Column > 6)
		{
		    fileUngetc (c);
		    c = ' ';
		}
		break;

	    default:
		Assert ("Unexpected line type" == NULL);
	}
    }
    return c;
}

static int skipToNextLine (void)
{
    int c = skipLine ();
    if (c != EOF)
	c = fileGetc ();
    return c;
}

static int getFreeFormChar (void)
{
    static boolean newline = TRUE;
    boolean advanceLine = FALSE;
    int c = fileGetc ();

    /* If the last nonblank, non-comment character of a FORTRAN 90
     * free-format text line is an ampersand then the next non-comment
     * line is a continuation line.
     */
    if (c == '&')
    {
	do
	    c = fileGetc ();
	while (isspace (c)  &&  c != '\n');
	if (c == '\n')
	{
	    newline = TRUE;
	    advanceLine = TRUE;
	}
	else if (c == '!')
	    advanceLine = TRUE;
	else
	{
	    fileUngetc (c);
	    c = '&';
	}
    }
    else if (newline && (c == '!' || c == '#'))
	advanceLine = TRUE;
    while (advanceLine)
    {
	while (isspace (c))
	    c = fileGetc ();
	if (c == '!' || (newline && c == '#'))
	{
	    c = skipToNextLine ();
	    newline = TRUE;
	    continue;
	}
	if (c == '&')
	    c = fileGetc ();
	else
	    advanceLine = FALSE;
    }
    newline = (boolean) (c == '\n');
    return c;
}

static int getChar (void)
{
    int c;

    if (Ungetc != '\0')
    {
	c = Ungetc;
	Ungetc = '\0';
    }
    else if (FreeSourceForm)
	c = getFreeFormChar ();
    else
	c = getFixedFormChar ();

    return c;
}

static void ungetChar (const int c)
{
    Ungetc = c;
}

/*  If a numeric is passed in 'c', this is used as the first digit of the
 *  numeric being parsed.
 */
static vString *parseInteger (int c)
{
    static vString *string = NULL;

    if (string == NULL)
	string = vStringNew ();
    vStringClear (string);

    if (c == '-')
    {
	vStringPut (string, c);
	c = getChar ();
    }
    else if (! isdigit (c))
	c = getChar ();
    while (c != EOF  &&  isdigit (c))
    {
	vStringPut (string, c);
	c = getChar ();
    }
    vStringTerminate (string);

    if (c == '_')
    {
	do
	    c = getChar ();
	while (c != EOF  &&  isalpha (c));
    }
    ungetChar (c);

    return string;
}

static vString *parseNumeric (int c)
{
    static vString *string = NULL;

    if (string == NULL)
	string = vStringNew ();
    vStringCopy (string, parseInteger (c));

    c = getChar ();
    if (c == '.')
    {
	vStringPut (string, c);
	vStringCat (string, parseInteger ('\0'));
	c = getChar ();
    }
    if (tolower (c) == 'e')
    {
	vStringPut (string, c);
	vStringCat (string, parseInteger ('\0'));
    }
    else
	ungetChar (c);

    vStringTerminate (string);

    return string;
}

static void parseString (vString *const string, const int delimeter)
{
    const unsigned long inputLineNumber = getInputLineNumber ();
    int c;
    ParsingString = TRUE;
    c = getChar ();
    while (c != delimeter  &&  c != '\n'  &&  c != EOF)
    {
	vStringPut (string, c);
	c = getChar ();
    }
    if (c == '\n'  ||  c == EOF)
    {
	verbose ("%s: unterminated character string at line %lu\n",
		getInputFileName (), inputLineNumber);
	if (c == EOF)
	    longjmp (Exception, (int) ExceptionEOF);
	else if (! FreeSourceForm)
	    longjmp (Exception, (int) ExceptionFixedFormat);
    }
    vStringTerminate (string);
    ParsingString = FALSE;
}

/*  Read a C identifier beginning with "firstChar" and places it into "name".
 */
static void parseIdentifier (vString *const string, const int firstChar)
{
    int c = firstChar;

    do
    {
	vStringPut (string, c);
	c = getChar ();
    } while (isident (c));

    vStringTerminate (string);
    ungetChar (c);		/* unget non-identifier character */
}

/*  Analyzes the identifier contained in a statement described by the
 *  statement structure and adjusts the structure according the significance
 *  of the identifier.
 */
static keywordId analyzeToken (vString *const name)
{
    static vString *keyword = NULL;
    keywordId id;

    if (keyword == NULL)
	keyword = vStringNew ();
    vStringCopyToLower (keyword, name);
    id = (keywordId) lookupKeyword (vStringValue (keyword), Lang_fortran);

    return id;
}

static void checkForLabel (void)
{
    tokenInfo* token = NULL;
    int length;
    int c;

    do
	c = getChar ();
    while (isBlank (c));

    for (length = 0  ;  isdigit (c)  &&  length < 5  ;  ++length)
    {
	if (token == NULL)
	{
	    token = newToken ();
	    token->type = TOKEN_LABEL;
	}
	vStringPut (token->string, c);
	c = getChar ();
    }
    if (length > 0)
    {
	Assert (token != NULL);
	vStringTerminate (token->string);
	makeFortranTag (token, TAG_LABEL);
	deleteToken (token);
    }
    ungetChar (c);
}

static void readIdentifier (tokenInfo *const token, const int c)
{
    parseIdentifier (token->string, c);
    token->keyword = analyzeToken (token->string);
    if (! isKeyword (token, KEYWORD_NONE))
	token->type = TOKEN_KEYWORD;
    else
    {
	token->type = TOKEN_IDENTIFIER;
	if (strncmp (vStringValue (token->string), "end", 3) == 0)
	{
	    vString *const sub = vStringNewInit (vStringValue (token->string) + 3);
	    const keywordId kw = analyzeToken (sub);
	    vStringDelete (sub);
	    if (kw != KEYWORD_NONE)
	    {
		token->secondary = newToken ();
		token->secondary->type = TOKEN_KEYWORD;
		token->secondary->keyword = kw;
		token->keyword = KEYWORD_end;
	    }
	}
    }
}

static void readToken (tokenInfo *const token)
{
    int c;

    deleteToken (token->secondary);
    token->type        = TOKEN_UNDEFINED;
    token->tag         = TAG_UNDEFINED;
    token->keyword     = KEYWORD_NONE;
    token->secondary   = NULL;
    vStringClear (token->string);

getNextChar:
    c = getChar ();

    token->lineNumber	= getSourceLineNumber ();
    token->filePosition	= getInputFilePosition ();

    switch (c)
    {
	case EOF:  longjmp (Exception, (int) ExceptionEOF);	break;
	case ' ':  goto getNextChar;
	case '\t': goto getNextChar;
	case ',':  token->type = TOKEN_COMMA;		break;
	case '(':  token->type = TOKEN_PAREN_OPEN;	break;
	case ')':  token->type = TOKEN_PAREN_CLOSE;	break;
	case '%':  token->type = TOKEN_PERCENT;		break;

	case '*':
	case '/':
	case '+':
	case '-':
	case '=':
	case '<':
	case '>':
	{
	    const char *const operatorChars = "*/+=<>";
	    do {
		vStringPut (token->string, c);
		c = getChar ();
	    } while (strchr (operatorChars, c) != NULL);
	    ungetChar (c);
	    vStringTerminate (token->string);
	    token->type = TOKEN_OPERATOR;
	    break;
	}

	case '!':
	    if (FreeSourceForm)
	    {
		do
		   c = getChar ();
		while (c != '\n');
	    }
	    else
	    {
		skipLine ();
		Column = 0;
	    }
	    /* fall through to newline case */
	case '\n':
	    token->type = TOKEN_STATEMENT_END;
	    if (FreeSourceForm)
		checkForLabel ();
	    break;

	case '.':
	    parseIdentifier (token->string, c);
	    c = getChar ();
	    if (c == '.')
	    {
		vStringPut (token->string, c);
		vStringTerminate (token->string);
		token->type = TOKEN_OPERATOR;
	    }
	    else
	    {
		ungetChar (c);
		token->type = TOKEN_UNDEFINED;
	    }
	    break;

	case '"':
	case '\'':
	    parseString (token->string, c);
	    token->type = TOKEN_STRING;
	    break;

	case ';':
	    token->type = TOKEN_STATEMENT_END;
	    break;

	case ':':
	    c = getChar ();
	    if (c == ':')
		token->type = TOKEN_DOUBLE_COLON;
	    else
	    {
		ungetChar (c);
		token->type = TOKEN_UNDEFINED;
	    }
	    break;

	default:
	    if (isalpha (c))
		readIdentifier (token, c);
	    else if (isdigit (c))
	    {
		vStringCat (token->string, parseNumeric (c));
		token->type = TOKEN_NUMERIC;
	    }
	    else
		token->type = TOKEN_UNDEFINED;
	    break;
    }
}

static void readSubToken (tokenInfo *const token)
{
    if (token->secondary == NULL)
    {
	token->secondary = newToken ();
	readToken (token->secondary);
    }
    Assert (token->secondary != NULL);
}

/*
*   Scanning functions
*/

static void skipToToken (tokenInfo *const token, tokenType type)
{
    while (! isType (token, type) && ! isType (token, TOKEN_STATEMENT_END) &&
	    !(token->secondary != NULL && isType (token->secondary, TOKEN_STATEMENT_END)))
	readToken (token);
}

static void skipPast (tokenInfo *const token, tokenType type)
{
    skipToToken (token, type);
    if (! isType (token, TOKEN_STATEMENT_END))
	readToken (token);
}

static void skipToNextStatement (tokenInfo *const token)
{
    do
    {
	skipToToken (token, TOKEN_STATEMENT_END);
	readToken (token);
    } while (isType (token, TOKEN_STATEMENT_END));
}

/* skip over parenthesis enclosed contents starting at next token.
 * Token is left at the first token following closing parenthesis. If an
 * opening parenthesis is not found, `token' is moved to the end of the
 * statement.
 */
static void skipOverParens (tokenInfo *const token)
{
    int level = 0;
    do {
	if (isType (token, TOKEN_STATEMENT_END))
	    break;
	else if (isType (token, TOKEN_PAREN_OPEN))
	    ++level;
	else if (isType (token, TOKEN_PAREN_CLOSE))
	    --level;
	readToken (token);
    } while (level > 0);