ctags.rb 1.0.19 → 1.1.3

data/ext/vendor/exuberant-ctags/fortran.c

@@ -1,2197 +0,0 @@
-/*
-*   $Id: fortran.c 660 2008-04-20 23:30:12Z elliotth $
-*
-*   Copyright (c) 1998-2003, Darren Hiebert
-*
-*   This source code is released for free distribution under the terms of the
-*   GNU General Public License.
-*
-*   This module contains functions for generating tags for Fortran language
-*   files.
-*/
-
-/*
-*   INCLUDE FILES
-*/
-#include "general.h"  /* must always come first */
-
-#include <string.h>
-#include <limits.h>
-#include <ctype.h>  /* to define tolower () */
-#include <setjmp.h>
-
-#include "debug.h"
-#include "entry.h"
-#include "keyword.h"
-#include "options.h"
-#include "parse.h"
-#include "read.h"
-#include "routines.h"
-#include "vstring.h"
-
-/*
-*   MACROS
-*/
-#define isident(c)              (isalnum(c) || (c) == '_')
-#define isBlank(c)              (boolean) (c == ' ' || c == '\t')
-#define isType(token,t)         (boolean) ((token)->type == (t))
-#define isKeyword(token,k)      (boolean) ((token)->keyword == (k))
-#define isSecondaryKeyword(token,k)  (boolean) ((token)->secondary == NULL ? \
-	FALSE : (token)->secondary->keyword == (k))
-
-/*
-*   DATA DECLARATIONS
-*/
-
-typedef enum eException {
-	ExceptionNone, ExceptionEOF, ExceptionFixedFormat, ExceptionLoop
-} exception_t;
-
-/*  Used to designate type of line read in fixed source form.
- */
-typedef enum eFortranLineType {
-	LTYPE_UNDETERMINED,
-	LTYPE_INVALID,
-	LTYPE_COMMENT,
-	LTYPE_CONTINUATION,
-	LTYPE_EOF,
-	LTYPE_INITIAL,
-	LTYPE_SHORT
-} lineType;
-
-/*  Used to specify type of keyword.
- */
-typedef enum eKeywordId {
-	KEYWORD_NONE = -1,
-	KEYWORD_allocatable,
-	KEYWORD_assignment,
-	KEYWORD_automatic,
-	KEYWORD_block,
-	KEYWORD_byte,
-	KEYWORD_cexternal,
-	KEYWORD_cglobal,
-	KEYWORD_character,
-	KEYWORD_common,
-	KEYWORD_complex,
-	KEYWORD_contains,
-	KEYWORD_data,
-	KEYWORD_dimension,
-	KEYWORD_dllexport,
-	KEYWORD_dllimport,
-	KEYWORD_do,
-	KEYWORD_double,
-	KEYWORD_elemental,
-	KEYWORD_end,
-	KEYWORD_entry,
-	KEYWORD_equivalence,
-	KEYWORD_external,
-	KEYWORD_format,
-	KEYWORD_function,
-	KEYWORD_if,
-	KEYWORD_implicit,
-	KEYWORD_include,
-	KEYWORD_inline,
-	KEYWORD_integer,
-	KEYWORD_intent,
-	KEYWORD_interface,
-	KEYWORD_intrinsic,
-	KEYWORD_logical,
-	KEYWORD_map,
-	KEYWORD_module,
-	KEYWORD_namelist,
-	KEYWORD_operator,
-	KEYWORD_optional,
-	KEYWORD_parameter,
-	KEYWORD_pascal,
-	KEYWORD_pexternal,
-	KEYWORD_pglobal,
-	KEYWORD_pointer,
-	KEYWORD_precision,
-	KEYWORD_private,
-	KEYWORD_program,
-	KEYWORD_public,
-	KEYWORD_pure,
-	KEYWORD_real,
-	KEYWORD_record,
-	KEYWORD_recursive,
-	KEYWORD_save,
-	KEYWORD_select,
-	KEYWORD_sequence,
-	KEYWORD_static,
-	KEYWORD_stdcall,
-	KEYWORD_structure,
-	KEYWORD_subroutine,
-	KEYWORD_target,
-	KEYWORD_then,
-	KEYWORD_type,
-	KEYWORD_union,
-	KEYWORD_use,
-	KEYWORD_value,
-	KEYWORD_virtual,
-	KEYWORD_volatile,
-	KEYWORD_where,
-	KEYWORD_while
-} keywordId;
-
-/*  Used to determine whether keyword is valid for the token language and
- *  what its ID is.
- */
-typedef struct sKeywordDesc {
-	const char *name;
-	keywordId id;
-} keywordDesc;
-
-typedef enum eTokenType {
-	TOKEN_UNDEFINED,
-	TOKEN_COMMA,
-	TOKEN_DOUBLE_COLON,
-	TOKEN_IDENTIFIER,
-	TOKEN_KEYWORD,
-	TOKEN_LABEL,
-	TOKEN_NUMERIC,
-	TOKEN_OPERATOR,
-	TOKEN_PAREN_CLOSE,
-	TOKEN_PAREN_OPEN,
-	TOKEN_PERCENT,
-	TOKEN_STATEMENT_END,
-	TOKEN_STRING
-} tokenType;
-
-typedef enum eTagType {
-	TAG_UNDEFINED = -1,
-	TAG_BLOCK_DATA,
-	TAG_COMMON_BLOCK,
-	TAG_ENTRY_POINT,
-	TAG_FUNCTION,
-	TAG_INTERFACE,
-	TAG_COMPONENT,
-	TAG_LABEL,
-	TAG_LOCAL,
-	TAG_MODULE,
-	TAG_NAMELIST,
-	TAG_PROGRAM,
-	TAG_SUBROUTINE,
-	TAG_DERIVED_TYPE,
-	TAG_VARIABLE,
-	TAG_COUNT  /* must be last */
-} tagType;
-
-typedef struct sTokenInfo {
-	tokenType type;
-	keywordId keyword;
-	tagType tag;
-	vString* string;
-	struct sTokenInfo *secondary;
-	unsigned long lineNumber;
-	fpos_t filePosition;
-} tokenInfo;
-
-/*
-*   DATA DEFINITIONS
-*/
-
-static langType Lang_fortran;
-static jmp_buf Exception;
-static int Ungetc;
-static unsigned int Column;
-static boolean FreeSourceForm;
-static boolean ParsingString;
-static tokenInfo *Parent;
-
-/* indexed by tagType */
-static kindOption FortranKinds [] = {
-	{ TRUE,  'b', "block data", "block data"},
-	{ TRUE,  'c', "common",     "common blocks"},
-	{ TRUE,  'e', "entry",      "entry points"},
-	{ TRUE,  'f', "function",   "functions"},
-	{ FALSE, 'i', "interface",  "interface contents, generic names, and operators"},
-	{ TRUE,  'k', "component",  "type and structure components"},
-	{ TRUE,  'l', "label",      "labels"},
-	{ FALSE, 'L', "local",      "local, common block, and namelist variables"},
-	{ TRUE,  'm', "module",     "modules"},
-	{ TRUE,  'n', "namelist",   "namelists"},
-	{ TRUE,  'p', "program",    "programs"},
-	{ TRUE,  's', "subroutine", "subroutines"},
-	{ TRUE,  't', "type",       "derived types and structures"},
-	{ TRUE,  'v', "variable",   "program (global) and module variables"}
-};
-
-/* For efinitions of Fortran 77 with extensions:
- * http://www.fortran.com/fortran/F77_std/rjcnf0001.html
- * http://scienide.uwaterloo.ca/MIPSpro7/007-2362-004/sgi_html/index.html
- *
- * For the Compaq Fortran Reference Manual:
- * http://h18009.www1.hp.com/fortran/docs/lrm/dflrm.htm
- */
-
-static const keywordDesc FortranKeywordTable [] = {
-	/* keyword          keyword ID */
-	{ "allocatable",    KEYWORD_allocatable  },
-	{ "assignment",     KEYWORD_assignment   },
-	{ "automatic",      KEYWORD_automatic    },
-	{ "block",          KEYWORD_block        },
-	{ "byte",           KEYWORD_byte         },
-	{ "cexternal",      KEYWORD_cexternal    },
-	{ "cglobal",        KEYWORD_cglobal      },
-	{ "character",      KEYWORD_character    },
-	{ "common",         KEYWORD_common       },
-	{ "complex",        KEYWORD_complex      },
-	{ "contains",       KEYWORD_contains     },
-	{ "data",           KEYWORD_data         },
-	{ "dimension",      KEYWORD_dimension    },
-	{ "dll_export",     KEYWORD_dllexport    },
-	{ "dll_import",     KEYWORD_dllimport    },
-	{ "do",             KEYWORD_do           },
-	{ "double",         KEYWORD_double       },
-	{ "elemental",      KEYWORD_elemental    },
-	{ "end",            KEYWORD_end          },
-	{ "entry",          KEYWORD_entry        },
-	{ "equivalence",    KEYWORD_equivalence  },
-	{ "external",       KEYWORD_external     },
-	{ "format",         KEYWORD_format       },
-	{ "function",       KEYWORD_function     },
-	{ "if",             KEYWORD_if           },
-	{ "implicit",       KEYWORD_implicit     },
-	{ "include",        KEYWORD_include      },
-	{ "inline",         KEYWORD_inline       },
-	{ "integer",        KEYWORD_integer      },
-	{ "intent",         KEYWORD_intent       },
-	{ "interface",      KEYWORD_interface    },
-	{ "intrinsic",      KEYWORD_intrinsic    },
-	{ "logical",        KEYWORD_logical      },
-	{ "map",            KEYWORD_map          },
-	{ "module",         KEYWORD_module       },
-	{ "namelist",       KEYWORD_namelist     },
-	{ "operator",       KEYWORD_operator     },
-	{ "optional",       KEYWORD_optional     },
-	{ "parameter",      KEYWORD_parameter    },
-	{ "pascal",         KEYWORD_pascal       },
-	{ "pexternal",      KEYWORD_pexternal    },
-	{ "pglobal",        KEYWORD_pglobal      },
-	{ "pointer",        KEYWORD_pointer      },
-	{ "precision",      KEYWORD_precision    },
-	{ "private",        KEYWORD_private      },
-	{ "program",        KEYWORD_program      },
-	{ "public",         KEYWORD_public       },
-	{ "pure",           KEYWORD_pure         },
-	{ "real",           KEYWORD_real         },
-	{ "record",         KEYWORD_record       },
-	{ "recursive",      KEYWORD_recursive    },
-	{ "save",           KEYWORD_save         },
-	{ "select",         KEYWORD_select       },
-	{ "sequence",       KEYWORD_sequence     },
-	{ "static",         KEYWORD_static       },
-	{ "stdcall",        KEYWORD_stdcall      },
-	{ "structure",      KEYWORD_structure    },
-	{ "subroutine",     KEYWORD_subroutine   },
-	{ "target",         KEYWORD_target       },
-	{ "then",           KEYWORD_then         },
-	{ "type",           KEYWORD_type         },
-	{ "union",          KEYWORD_union        },
-	{ "use",            KEYWORD_use          },
-	{ "value",          KEYWORD_value        },
-	{ "virtual",        KEYWORD_virtual      },
-	{ "volatile",       KEYWORD_volatile     },
-	{ "where",          KEYWORD_where        },
-	{ "while",          KEYWORD_while        }
-};
-
-static struct {
-	unsigned int count;
-	unsigned int max;
-	tokenInfo* list;
-} Ancestors = { 0, 0, NULL };
-
-/*
-*   FUNCTION PROTOTYPES
-*/
-static void parseStructureStmt (tokenInfo *const token);
-static void parseUnionStmt (tokenInfo *const token);
-static void parseDerivedTypeDef (tokenInfo *const token);
-static void parseFunctionSubprogram (tokenInfo *const token);
-static void parseSubroutineSubprogram (tokenInfo *const token);
-
-/*
-*   FUNCTION DEFINITIONS
-*/
-
-static void ancestorPush (tokenInfo *const token)
-{
-	enum { incrementalIncrease = 10 };
-	if (Ancestors.list == NULL)
-	{
-		Assert (Ancestors.max == 0);
-		Ancestors.count = 0;
-		Ancestors.max   = incrementalIncrease;
-		Ancestors.list  = xMalloc (Ancestors.max, tokenInfo);
-	}
-	else if (Ancestors.count == Ancestors.max)
-	{
-		Ancestors.max += incrementalIncrease;
-		Ancestors.list = xRealloc (Ancestors.list, Ancestors.max, tokenInfo);
-	}
-	Ancestors.list [Ancestors.count] = *token;
-	Ancestors.list [Ancestors.count].string = vStringNewCopy (token->string);
-	Ancestors.count++;
-}
-
-static void ancestorPop (void)
-{
-	Assert (Ancestors.count > 0);
-	--Ancestors.count;
-	vStringDelete (Ancestors.list [Ancestors.count].string);
-
-	Ancestors.list [Ancestors.count].type       = TOKEN_UNDEFINED;
-	Ancestors.list [Ancestors.count].keyword    = KEYWORD_NONE;
-	Ancestors.list [Ancestors.count].secondary  = NULL;
-	Ancestors.list [Ancestors.count].tag        = TAG_UNDEFINED;
-	Ancestors.list [Ancestors.count].string     = NULL;
-	Ancestors.list [Ancestors.count].lineNumber = 0L;
-}
-
-static const tokenInfo* ancestorScope (void)
-{
-	tokenInfo *result = NULL;
-	unsigned int i;
-	for (i = Ancestors.count  ;  i > 0  &&  result == NULL ;  --i)
-	{
-		tokenInfo *const token = Ancestors.list + i - 1;
-		if (token->type == TOKEN_IDENTIFIER &&
-			token->tag != TAG_UNDEFINED  && token->tag != TAG_INTERFACE)
-			result = token;
-	}
-	return result;
-}
-
-static const tokenInfo* ancestorTop (void)
-{
-	Assert (Ancestors.count > 0);
-	return &Ancestors.list [Ancestors.count - 1];
-}
-
-#define ancestorCount() (Ancestors.count)
-
-static void ancestorClear (void)
-{
-	while (Ancestors.count > 0)
-		ancestorPop ();
-	if (Ancestors.list != NULL)
-		eFree (Ancestors.list);
-	Ancestors.list = NULL;
-	Ancestors.count = 0;
-	Ancestors.max = 0;
-}
-
-static boolean insideInterface (void)
-{
-	boolean result = FALSE;
-	unsigned int i;
-	for (i = 0  ;  i < Ancestors.count && !result ;  ++i)
-	{
-		if (Ancestors.list [i].tag == TAG_INTERFACE)
-			result = TRUE;
-	}
-	return result;
-}
-
-static void buildFortranKeywordHash (void)
-{
-	const size_t count =
-			sizeof (FortranKeywordTable) / sizeof (FortranKeywordTable [0]);
-	size_t i;
-	for (i = 0  ;  i < count  ;  ++i)
-	{
-		const keywordDesc* const p = &FortranKeywordTable [i];
-		addKeyword (p->name, Lang_fortran, (int) p->id);
-	}
-}
-
-/*
-*   Tag generation functions
-*/
-
-static tokenInfo *newToken (void)
-{
-	tokenInfo *const token = xMalloc (1, tokenInfo);
-
-	token->type         = TOKEN_UNDEFINED;
-	token->keyword      = KEYWORD_NONE;
-	token->tag          = TAG_UNDEFINED;
-	token->string       = vStringNew ();
-	token->secondary    = NULL;
-	token->lineNumber   = getSourceLineNumber ();
-	token->filePosition = getInputFilePosition ();
-
-	return token;
-}
-
-static tokenInfo *newTokenFrom (tokenInfo *const token)
-{
-	tokenInfo *result = newToken ();
-	*result = *token;
-	result->string = vStringNewCopy (token->string);
-	token->secondary = NULL;
-	return result;
-}
-
-static void deleteToken (tokenInfo *const token)
-{
-	if (token != NULL)
-	{
-		vStringDelete (token->string);
-		deleteToken (token->secondary);
-		token->secondary = NULL;
-		eFree (token);
-	}
-}
-
-static boolean isFileScope (const tagType type)
-{
-	return (boolean) (type == TAG_LABEL || type == TAG_LOCAL);
-}
-
-static boolean includeTag (const tagType type)
-{
-	boolean include;
-	Assert (type != TAG_UNDEFINED);
-	include = FortranKinds [(int) type].enabled;
-	if (include && isFileScope (type))
-		include = Option.include.fileScope;
-	return include;
-}
-
-static void makeFortranTag (tokenInfo *const token, tagType tag)
-{
-	token->tag = tag;
-	if (includeTag (token->tag))
-	{
-		const char *const name = vStringValue (token->string);
-		tagEntryInfo e;
-
-		initTagEntry (&e, name);
-
-		if (token->tag == TAG_COMMON_BLOCK)
-			e.lineNumberEntry = (boolean) (Option.locate != EX_PATTERN);
-
-		e.lineNumber	= token->lineNumber;
-		e.filePosition	= token->filePosition;
-		e.isFileScope	= isFileScope (token->tag);
-		e.kindName		= FortranKinds [token->tag].name;
-		e.kind			= FortranKinds [token->tag].letter;
-		e.truncateLine	= (boolean) (token->tag != TAG_LABEL);
-
-		if (ancestorCount () > 0)
-		{
-			const tokenInfo* const scope = ancestorScope ();
-			if (scope != NULL)
-			{
-				e.extensionFields.scope [0] = FortranKinds [scope->tag].name;
-				e.extensionFields.scope [1] = vStringValue (scope->string);
-			}
-		}
-		if (! insideInterface () || includeTag (TAG_INTERFACE))
-			makeTagEntry (&e);
-	}
-}
-
-/*
-*   Parsing functions
-*/
-
-static int skipLine (void)
-{
-	int c;
-
-	do
-		c = fileGetc ();
-	while (c != EOF  &&  c != '\n');
-
-	return c;
-}
-
-static void makeLabelTag (vString *const label)
-{
-	tokenInfo *token = newToken ();
-	token->type  = TOKEN_LABEL;
-	vStringCopy (token->string, label);
-	makeFortranTag (token, TAG_LABEL);
-	deleteToken (token);
-}
-
-static lineType getLineType (void)
-{
-	vString *label = vStringNew ();
-	int column = 0;
-	lineType type = LTYPE_UNDETERMINED;
-
-	do  /* read in first 6 "margin" characters */
-	{
-		int c = fileGetc ();
-
-		/* 3.2.1  Comment_Line.  A comment line is any line that contains
-		 * a C or an asterisk in column 1, or contains only blank characters
-		 * in  columns 1 through 72.  A comment line that contains a C or
-		 * an asterisk in column 1 may contain any character capable  of
-		 * representation in the processor in columns 2 through 72.
-		 */
-		/*  EXCEPTION! Some compilers permit '!' as a commment character here.
-		 *
-		 *  Treat # and $ in column 1 as comment to permit preprocessor directives.
-		 *  Treat D and d in column 1 as comment for HP debug statements.
-		 */
-		if (column == 0  &&  strchr ("*Cc!#$Dd", c) != NULL)
-			type = LTYPE_COMMENT;
-		else if (c == '\t')  /* EXCEPTION! Some compilers permit a tab here */
-		{
-			column = 8;
-			type = LTYPE_INITIAL;
-		}
-		else if (column == 5)
-		{
-			/* 3.2.2  Initial_Line.  An initial line is any line that is not
-			 * a comment line and contains the character blank or the digit 0
-			 * in column 6.  Columns 1 through 5 may contain a statement label
-			 * (3.4), or each of the columns 1 through 5 must contain the
-			 * 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);
-	}
-	vStringDelete (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)
-{
-	vString *string = vStringNew ();
-
-	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)
-{
-	vString *string = vStringNew ();
-	vString *integer = parseInteger (c);
-	vStringCopy (string, integer);
-	vStringDelete (integer);
-
-	c = getChar ();
-	if (c == '.')
-	{
-		integer = parseInteger ('\0');
-		vStringPut (string, c);
-		vStringCat (string, integer);
-		vStringDelete (integer);
-		c = getChar ();
-	}
-	if (tolower (c) == 'e')
-	{
-		integer = parseInteger ('\0');
-		vStringPut (string, c);
-		vStringCat (string, integer);
-		vStringDelete (integer);
-	}
-	else
-		ungetChar (c);
-
-	vStringTerminate (string);
-
-	return string;
-}
-
-static void parseString (vString *const string, const int delimiter)
-{
-	const unsigned long inputLineNumber = getInputLineNumber ();
-	int c;
-	ParsingString = TRUE;
-	c = getChar ();
-	while (c != delimiter  &&  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 */
-}
-
-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  &&  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, Lang_fortran);
-	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, Lang_fortran);
-			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' && c != EOF);
-			}
-			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))
-			{
-				vString *numeric = parseNumeric (c);
-				vStringCat (token->string, numeric);
-				vStringDelete (numeric);
-				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);
-	}
-}
-
-/*
-*   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);
-}
-
-static boolean isTypeSpec (tokenInfo *const token)
-{
-	boolean result;
-	switch (token->keyword)
-	{
-		case KEYWORD_byte:
-		case KEYWORD_integer:
-		case KEYWORD_real:
-		case KEYWORD_double:
-		case KEYWORD_complex:
-		case KEYWORD_character:
-		case KEYWORD_logical:
-		case KEYWORD_record:
-		case KEYWORD_type:
-			result = TRUE;
-			break;
-		default:
-			result = FALSE;
-			break;
-	}
-	return result;
-}
-
-static boolean isSubprogramPrefix (tokenInfo *const token)
-{
-	boolean result;
-	switch (token->keyword)
-	{
-		case KEYWORD_elemental:
-		case KEYWORD_pure:
-		case KEYWORD_recursive:
-		case KEYWORD_stdcall:
-			result = TRUE;
-			break;
-		default:
-			result = FALSE;
-			break;
-	}
-	return result;
-}
-
-/*  type-spec
- *      is INTEGER [kind-selector]
- *      or REAL [kind-selector] is ( etc. )
- *      or DOUBLE PRECISION
- *      or COMPLEX [kind-selector]
- *      or CHARACTER [kind-selector]
- *      or LOGICAL [kind-selector]
- *      or TYPE ( type-name )
- *
- *  Note that INTEGER and REAL may be followed by "*N" where "N" is an integer
- */
-static void parseTypeSpec (tokenInfo *const token)
-{
-	/* parse type-spec, leaving `token' at first token following type-spec */
-	Assert (isTypeSpec (token));
-	switch (token->keyword)
-	{
-		case KEYWORD_character:
-			/* skip char-selector */
-			readToken (token);
-			if (isType (token, TOKEN_OPERATOR) &&
-					 strcmp (vStringValue (token->string), "*") == 0)
-				readToken (token);
-			if (isType (token, TOKEN_PAREN_OPEN))
-				skipOverParens (token);
-			else if (isType (token, TOKEN_NUMERIC))
-				readToken (token);
-			break;
-
-
-		case KEYWORD_byte:
-		case KEYWORD_complex:
-		case KEYWORD_integer:
-		case KEYWORD_logical:
-		case KEYWORD_real:
-			readToken (token);
-			if (isType (token, TOKEN_PAREN_OPEN))
-				skipOverParens (token);  /* skip kind-selector */
-			if (isType (token, TOKEN_OPERATOR) &&
-				strcmp (vStringValue (token->string), "*") == 0)
-			{
-				readToken (token);
-				readToken (token);
-			}
-			break;
-
-		case KEYWORD_double:
-			readToken (token);
-			if (isKeyword (token, KEYWORD_complex) ||
-				isKeyword (token, KEYWORD_precision))
-					readToken (token);
-			else
-				skipToToken (token, TOKEN_STATEMENT_END);
-			break;
-
-		case KEYWORD_record:
-			readToken (token);
-			if (isType (token, TOKEN_OPERATOR) &&
-				strcmp (vStringValue (token->string), "/") == 0)
-			{
-				readToken (token);  /* skip to structure name */
-				readToken (token);  /* skip to '/' */
-				readToken (token);  /* skip to variable name */
-			}
-			break;
-
-		case KEYWORD_type:
-			readToken (token);
-			if (isType (token, TOKEN_PAREN_OPEN))
-				skipOverParens (token);  /* skip type-name */
-			else
-				parseDerivedTypeDef (token);
-			break;
-
-		default:
-			skipToToken (token, TOKEN_STATEMENT_END);
-			break;
-	}
-}
-
-static boolean skipStatementIfKeyword (tokenInfo *const token, keywordId keyword)
-{
-	boolean result = FALSE;
-	if (isKeyword (token, keyword))
-	{
-		result = TRUE;
-		skipToNextStatement (token);
-	}
-	return result;
-}
-
-/* parse a list of qualifying specifiers, leaving `token' at first token
- * following list. Examples of such specifiers are:
- *      [[, attr-spec] ::]
- *      [[, component-attr-spec-list] ::]
- *
- *  attr-spec
- *      is PARAMETER
- *      or access-spec (is PUBLIC or PRIVATE)
- *      or ALLOCATABLE
- *      or DIMENSION ( array-spec )
- *      or EXTERNAL
- *      or INTENT ( intent-spec )
- *      or INTRINSIC
- *      or OPTIONAL
- *      or POINTER
- *      or SAVE
- *      or TARGET
- * 
- *  component-attr-spec
- *      is POINTER
- *      or DIMENSION ( component-array-spec )
- */
-static void parseQualifierSpecList (tokenInfo *const token)
-{
-	do
-	{
-		readToken (token);  /* should be an attr-spec */
-		switch (token->keyword)
-		{
-			case KEYWORD_parameter:
-			case KEYWORD_allocatable:
-			case KEYWORD_external:
-			case KEYWORD_intrinsic:
-			case KEYWORD_optional:
-			case KEYWORD_private:
-			case KEYWORD_pointer:
-			case KEYWORD_public:
-			case KEYWORD_save:
-			case KEYWORD_target:
-				readToken (token);
-				break;
-
-			case KEYWORD_dimension:
-			case KEYWORD_intent:
-				readToken (token);
-				skipOverParens (token);
-				break;
-
-			default: skipToToken (token, TOKEN_STATEMENT_END); break;
-		}
-	} while (isType (token, TOKEN_COMMA));
-	if (! isType (token, TOKEN_DOUBLE_COLON))
-		skipToToken (token, TOKEN_STATEMENT_END);
-}
-
-static tagType variableTagType (void)
-{
-	tagType result = TAG_VARIABLE;
-	if (ancestorCount () > 0)
-	{
-		const tokenInfo* const parent = ancestorTop ();
-		switch (parent->tag)
-		{
-			case TAG_MODULE:       result = TAG_VARIABLE;  break;
-			case TAG_DERIVED_TYPE: result = TAG_COMPONENT; break;
-			case TAG_FUNCTION:     result = TAG_LOCAL;     break;
-			case TAG_SUBROUTINE:   result = TAG_LOCAL;     break;
-			default:               result = TAG_VARIABLE;  break;
-		}
-	}
-	return result;
-}
-
-static void parseEntityDecl (tokenInfo *const token)
-{
-	Assert (isType (token, TOKEN_IDENTIFIER));
-	makeFortranTag (token, variableTagType ());
-	readToken (token);
-	if (isType (token, TOKEN_PAREN_OPEN))
-		skipOverParens (token);
-	if (isType (token, TOKEN_OPERATOR) &&
-			strcmp (vStringValue (token->string), "*") == 0)
-	{
-		readToken (token);  /* read char-length */
-		if (isType (token, TOKEN_PAREN_OPEN))
-			skipOverParens (token);
-		else
-			readToken (token);
-	}
-	if (isType (token, TOKEN_OPERATOR))
-	{
-		if (strcmp (vStringValue (token->string), "/") == 0)
-		{  /* skip over initializations of structure field */
-			readToken (token);
-			skipPast (token, TOKEN_OPERATOR);
-		}
-		else if (strcmp (vStringValue (token->string), "=") == 0)
-		{
-			while (! isType (token, TOKEN_COMMA) &&
-					! isType (token, TOKEN_STATEMENT_END))
-			{
-				readToken (token);
-				if (isType (token, TOKEN_PAREN_OPEN))
-					skipOverParens (token);
-			}
-		}
-	}
-	/* token left at either comma or statement end */
-}
-
-static void parseEntityDeclList (tokenInfo *const token)
-{
-	if (isType (token, TOKEN_PERCENT))
-		skipToNextStatement (token);
-	else while (isType (token, TOKEN_IDENTIFIER) ||
-				(isType (token, TOKEN_KEYWORD) &&
-				 !isKeyword (token, KEYWORD_function) &&
-				 !isKeyword (token, KEYWORD_subroutine)))
-	{
-		/* compilers accept keywoeds as identifiers */
-		if (isType (token, TOKEN_KEYWORD))
-			token->type = TOKEN_IDENTIFIER;
-		parseEntityDecl (token);
-		if (isType (token, TOKEN_COMMA))
-			readToken (token);
-		else if (isType (token, TOKEN_STATEMENT_END))
-		{
-			skipToNextStatement (token);
-			break;
-		}
-	}
-}
-
-/*  type-declaration-stmt is
- *      type-spec [[, attr-spec] ... ::] entity-decl-list
- */
-static void parseTypeDeclarationStmt (tokenInfo *const token)
-{
-	Assert (isTypeSpec (token));
-	parseTypeSpec (token);
-	if (!isType (token, TOKEN_STATEMENT_END))  /* if not end of derived type... */
-	{
-		if (isType (token, TOKEN_COMMA))
-			parseQualifierSpecList (token);
-		if (isType (token, TOKEN_DOUBLE_COLON))
-			readToken (token);
-		parseEntityDeclList (token);
-	}
-	if (isType (token, TOKEN_STATEMENT_END))
-		skipToNextStatement (token);
-}
-
-/*  namelist-stmt is
- *      NAMELIST /namelist-group-name/ namelist-group-object-list
- *			[[,]/[namelist-group-name]/ namelist-block-object-list] ...
- *
- *  namelist-group-object is
- *      variable-name
- *
- *  common-stmt is
- *      COMMON [/[common-block-name]/] common-block-object-list
- *			[[,]/[common-block-name]/ common-block-object-list] ...
- *
- *  common-block-object is
- *      variable-name [ ( explicit-shape-spec-list ) ]
- */
-static void parseCommonNamelistStmt (tokenInfo *const token, tagType type)
-{
-	Assert (isKeyword (token, KEYWORD_common) ||
-			isKeyword (token, KEYWORD_namelist));
-	readToken (token);
-	do
-	{
-		if (isType (token, TOKEN_OPERATOR) &&
-			strcmp (vStringValue (token->string), "/") == 0)
-		{
-			readToken (token);
-			if (isType (token, TOKEN_IDENTIFIER))
-			{
-				makeFortranTag (token, type);
-				readToken (token);
-			}
-			skipPast (token, TOKEN_OPERATOR);
-		}
-		if (isType (token, TOKEN_IDENTIFIER))
-			makeFortranTag (token, TAG_LOCAL);
-		readToken (token);
-		if (isType (token, TOKEN_PAREN_OPEN))
-			skipOverParens (token);  /* skip explicit-shape-spec-list */
-		if (isType (token, TOKEN_COMMA))
-			readToken (token);
-	} while (! isType (token, TOKEN_STATEMENT_END));
-	skipToNextStatement (token);
-}
-
-static void parseFieldDefinition (tokenInfo *const token)
-{
-	if (isTypeSpec (token))
-		parseTypeDeclarationStmt (token);
-	else if (isKeyword (token, KEYWORD_structure))
-		parseStructureStmt (token);
-	else if (isKeyword (token, KEYWORD_union))
-		parseUnionStmt (token);
-	else
-		skipToNextStatement (token);
-}
-
-static void parseMap (tokenInfo *const token)
-{
-	Assert (isKeyword (token, KEYWORD_map));
-	skipToNextStatement (token);
-	while (! isKeyword (token, KEYWORD_end))
-		parseFieldDefinition (token);
-	readSubToken (token);
-	/* should be at KEYWORD_map token */
-	skipToNextStatement (token);
-}
-
-/* UNION
- *      MAP
- *          [field-definition] [field-definition] ... 
- *      END MAP
- *      MAP
- *          [field-definition] [field-definition] ... 
- *      END MAP
- *      [MAP
- *          [field-definition]
- *          [field-definition] ... 
- *      END MAP] ...
- *  END UNION 
- *      *
- *
- *  Typed data declarations (variables or arrays) in structure declarations
- *  have the form of normal Fortran typed data declarations. Data items with
- *  different types can be freely intermixed within a structure declaration.
- *
- *  Unnamed fields can be declared in a structure by specifying the pseudo
- *  name %FILL in place of an actual field name. You can use this mechanism to
- *  generate empty space in a record for purposes such as alignment.
- *
- *  All mapped field declarations that are made within a UNION declaration
- *  share a common location within the containing structure. When initializing
- *  the fields within a UNION, the final initialization value assigned
- *  overlays any value previously assigned to a field definition that shares
- *  that field. 
- */
-static void parseUnionStmt (tokenInfo *const token)
-{
-	Assert (isKeyword (token, KEYWORD_union));
-	skipToNextStatement (token);
-	while (isKeyword (token, KEYWORD_map))
-		parseMap (token);
-	/* should be at KEYWORD_end token */
-	readSubToken (token);
-	/* secondary token should be KEYWORD_end token */
-	skipToNextStatement (token);
-}
-
-/*  STRUCTURE [/structure-name/] [field-names]
- *      [field-definition]
- *      [field-definition] ...
- *  END STRUCTURE
- *
- *  structure-name
- *		identifies the structure in a subsequent RECORD statement.
- *		Substructures can be established within a structure by means of either
- *		a nested STRUCTURE declaration or a RECORD statement. 
- *
- *   field-names
- *		(for substructure declarations only) one or more names having the
- *		structure of the substructure being defined. 
- *
- *   field-definition
- *		can be one or more of the following:
- *
- *			Typed data declarations, which can optionally include one or more
- *			data initialization values.
- *
- *			Substructure declarations (defined by either RECORD statements or
- *			subsequent STRUCTURE statements).
- *
- *			UNION declarations, which are mapped fields defined by a block of
- *			statements. The syntax of a UNION declaration is described below.
- *
- *			PARAMETER statements, which do not affect the form of the
- *			structure. 
- */
-static void parseStructureStmt (tokenInfo *const token)
-{
-	tokenInfo *name;
-	Assert (isKeyword (token, KEYWORD_structure));
-	readToken (token);
-	if (isType (token, TOKEN_OPERATOR) &&
-		strcmp (vStringValue (token->string), "/") == 0)
-	{  /* read structure name */
-		readToken (token);
-		if (isType (token, TOKEN_IDENTIFIER))
-			makeFortranTag (token, TAG_DERIVED_TYPE);
-		name = newTokenFrom (token);
-		skipPast (token, TOKEN_OPERATOR);
-	}
-	else
-	{  /* fake out anonymous structure */
-		name = newToken ();
-		name->type = TOKEN_IDENTIFIER;
-		name->tag = TAG_DERIVED_TYPE;
-		vStringCopyS (name->string, "anonymous");
-	}
-	while (isType (token, TOKEN_IDENTIFIER))
-	{  /* read field names */
-		makeFortranTag (token, TAG_COMPONENT);
-		readToken (token);
-		if (isType (token, TOKEN_COMMA))
-			readToken (token);
-	}
-	skipToNextStatement (token);
-	ancestorPush (name);
-	while (! isKeyword (token, KEYWORD_end))
-		parseFieldDefinition (token);
-	readSubToken (token);
-	/* secondary token should be KEYWORD_structure token */
-	skipToNextStatement (token);
-	ancestorPop ();
-	deleteToken (name);
-}
-
-/*  specification-stmt
- *      is access-stmt      (is access-spec [[::] access-id-list)
- *      or allocatable-stmt (is ALLOCATABLE [::] array-name etc.)
- *      or common-stmt      (is COMMON [ / [common-block-name] /] etc.)
- *      or data-stmt        (is DATA data-stmt-list [[,] data-stmt-set] ...)
- *      or dimension-stmt   (is DIMENSION [::] array-name etc.)
- *      or equivalence-stmt (is EQUIVALENCE equivalence-set-list)
- *      or external-stmt    (is EXTERNAL etc.)
- *      or intent-stmt      (is INTENT ( intent-spec ) [::] etc.)
- *      or instrinsic-stmt  (is INTRINSIC etc.)
- *      or namelist-stmt    (is NAMELIST / namelist-group-name / etc.)
- *      or optional-stmt    (is OPTIONAL [::] etc.)
- *      or pointer-stmt     (is POINTER [::] object-name etc.)
- *      or save-stmt        (is SAVE etc.)
- *      or target-stmt      (is TARGET [::] object-name etc.)
- *
- *  access-spec is PUBLIC or PRIVATE
- */
-static boolean parseSpecificationStmt (tokenInfo *const token)
-{
-	boolean result = TRUE;
-	switch (token->keyword)
-	{
-		case KEYWORD_common:
-			parseCommonNamelistStmt (token, TAG_COMMON_BLOCK);
-			break;
-
-		case KEYWORD_namelist:
-			parseCommonNamelistStmt (token, TAG_NAMELIST);
-			break;
-
-		case KEYWORD_structure:
-			parseStructureStmt (token);
-			break;
-
-		case KEYWORD_allocatable:
-		case KEYWORD_data:
-		case KEYWORD_dimension:
-		case KEYWORD_equivalence:
-		case KEYWORD_external:
-		case KEYWORD_intent:
-		case KEYWORD_intrinsic:
-		case KEYWORD_optional:
-		case KEYWORD_pointer:
-		case KEYWORD_private:
-		case KEYWORD_public:
-		case KEYWORD_save:
-		case KEYWORD_target:
-			skipToNextStatement (token);
-			break;
-
-		default:
-			result = FALSE;
-			break;
-	}
-	return result;
-}
-
-/*  component-def-stmt is
- *      type-spec [[, component-attr-spec-list] ::] component-decl-list
- *
- *  component-decl is
- *      component-name [ ( component-array-spec ) ] [ * char-length ]
- */
-static void parseComponentDefStmt (tokenInfo *const token)
-{
-	Assert (isTypeSpec (token));
-	parseTypeSpec (token);
-	if (isType (token, TOKEN_COMMA))
-		parseQualifierSpecList (token);
-	if (isType (token, TOKEN_DOUBLE_COLON))
-		readToken (token);
-	parseEntityDeclList (token);
-}
-
-/*  derived-type-def is
- *      derived-type-stmt is (TYPE [[, access-spec] ::] type-name
- *          [private-sequence-stmt] ... (is PRIVATE or SEQUENCE)
- *          component-def-stmt
- *          [component-def-stmt] ...
- *          end-type-stmt
- */
-static void parseDerivedTypeDef (tokenInfo *const token)
-{
-	if (isType (token, TOKEN_COMMA))
-		parseQualifierSpecList (token);
-	if (isType (token, TOKEN_DOUBLE_COLON))
-		readToken (token);
-	if (isType (token, TOKEN_IDENTIFIER))
-		makeFortranTag (token, TAG_DERIVED_TYPE);
-	ancestorPush (token);
-	skipToNextStatement (token);
-	if (isKeyword (token, KEYWORD_private) ||
-		isKeyword (token, KEYWORD_sequence))
-	{
-		skipToNextStatement (token);
-	}
-	while (! isKeyword (token, KEYWORD_end))
-	{
-		if (isTypeSpec (token))
-			parseComponentDefStmt (token);
-		else
-			skipToNextStatement (token);
-	}
-	readSubToken (token);
-	/* secondary token should be KEYWORD_type token */
-	skipToToken (token, TOKEN_STATEMENT_END);
-	ancestorPop ();
-}
-
-/*  interface-block
- *      interface-stmt (is INTERFACE [generic-spec])
- *          [interface-body]
- *          [module-procedure-stmt] ...
- *          end-interface-stmt (is END INTERFACE)
- *
- *  generic-spec
- *      is generic-name
- *      or OPERATOR ( defined-operator )
- *      or ASSIGNMENT ( = )
- *
- *  interface-body
- *      is function-stmt
- *          [specification-part]
- *          end-function-stmt
- *      or subroutine-stmt
- *          [specification-part]
- *          end-subroutine-stmt
- *
- *  module-procedure-stmt is
- *      MODULE PROCEDURE procedure-name-list
- */
-static void parseInterfaceBlock (tokenInfo *const token)
-{
-	tokenInfo *name = NULL;
-	Assert (isKeyword (token, KEYWORD_interface));
-	readToken (token);
-	if (isType (token, TOKEN_IDENTIFIER))
-	{
-		makeFortranTag (token, TAG_INTERFACE);
-		name = newTokenFrom (token);
-	}
-	else if (isKeyword (token, KEYWORD_assignment) ||
-			 isKeyword (token, KEYWORD_operator))
-	{
-		readToken (token);
-		if (isType (token, TOKEN_PAREN_OPEN))
-			readToken (token);
-		if (isType (token, TOKEN_OPERATOR))
-		{
-			makeFortranTag (token, TAG_INTERFACE);
-			name = newTokenFrom (token);
-		}
-	}
-	if (name == NULL)
-	{
-		name = newToken ();
-		name->type = TOKEN_IDENTIFIER;
-		name->tag = TAG_INTERFACE;
-	}
-	ancestorPush (name);
-	while (! isKeyword (token, KEYWORD_end))
-	{
-		switch (token->keyword)
-		{
-			case KEYWORD_function:   parseFunctionSubprogram (token);   break;
-			case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
-
-			default:
-				if (isSubprogramPrefix (token))
-					readToken (token);
-				else if (isTypeSpec (token))
-					parseTypeSpec (token);
-				else
-					skipToNextStatement (token);
-				break;
-		}
-	}
-	readSubToken (token);
-	/* secondary token should be KEYWORD_interface token */
-	skipToNextStatement (token);
-	ancestorPop ();
-	deleteToken (name);
-}
-
-/*  entry-stmt is
- *      ENTRY entry-name [ ( dummy-arg-list ) ]
- */
-static void parseEntryStmt (tokenInfo *const token)
-{
-	Assert (isKeyword (token, KEYWORD_entry));
-	readToken (token);
-	if (isType (token, TOKEN_IDENTIFIER))
-		makeFortranTag (token, TAG_ENTRY_POINT);
-	skipToNextStatement (token);
-}
-
-/*  stmt-function-stmt is
- *      function-name ([dummy-arg-name-list]) = scalar-expr
- */
-static boolean parseStmtFunctionStmt (tokenInfo *const token)
-{
-	boolean result = FALSE;
-	Assert (isType (token, TOKEN_IDENTIFIER));
-#if 0  /* cannot reliably parse this yet */
-	makeFortranTag (token, TAG_FUNCTION);
-#endif
-	readToken (token);
-	if (isType (token, TOKEN_PAREN_OPEN))
-	{
-		skipOverParens (token);
-		result = (boolean) (isType (token, TOKEN_OPERATOR) &&
-			strcmp (vStringValue (token->string), "=") == 0);
-	}
-	skipToNextStatement (token);
-	return result;
-}
-
-static boolean isIgnoredDeclaration (tokenInfo *const token)
-{
-	boolean result;
-	switch (token->keyword)
-	{
-		case KEYWORD_cexternal:
-		case KEYWORD_cglobal:
-		case KEYWORD_dllexport:
-		case KEYWORD_dllimport:
-		case KEYWORD_external:
-		case KEYWORD_format:
-		case KEYWORD_include:
-		case KEYWORD_inline:
-		case KEYWORD_parameter:
-		case KEYWORD_pascal:
-		case KEYWORD_pexternal:
-		case KEYWORD_pglobal:
-		case KEYWORD_static:
-		case KEYWORD_value:
-		case KEYWORD_virtual:
-		case KEYWORD_volatile:
-			result = TRUE;
-			break;
-
-		default:
-			result = FALSE;
-			break;
-	}
-	return result;
-}
-
-/*  declaration-construct
- *      [derived-type-def]
- *      [interface-block]
- *      [type-declaration-stmt]
- *      [specification-stmt]
- *      [parameter-stmt] (is PARAMETER ( named-constant-def-list )
- *      [format-stmt]    (is FORMAT format-specification)
- *      [entry-stmt]
- *      [stmt-function-stmt]
- */
-static boolean parseDeclarationConstruct (tokenInfo *const token)
-{
-	boolean result = TRUE;
-	switch (token->keyword)
-	{
-		case KEYWORD_entry:		parseEntryStmt (token);      break;
-		case KEYWORD_interface:	parseInterfaceBlock (token); break;
-		case KEYWORD_stdcall:   readToken (token);           break;
-		/* derived type handled by parseTypeDeclarationStmt(); */
-
-		case KEYWORD_automatic:
-			readToken (token);
-			if (isTypeSpec (token))
-				parseTypeDeclarationStmt (token);
-			else
-				skipToNextStatement (token);
-			result = TRUE;
-			break;
-
-		default:
-			if (isIgnoredDeclaration (token))
-				skipToNextStatement (token);
-			else if (isTypeSpec (token))
-			{
-				parseTypeDeclarationStmt (token);
-				result = TRUE;
-			}
-			else if (isType (token, TOKEN_IDENTIFIER))
-				result = parseStmtFunctionStmt (token);
-			else
-				result = parseSpecificationStmt (token);
-			break;
-	}
-	return result;
-}
-
-/*  implicit-part-stmt
- *      is [implicit-stmt] (is IMPLICIT etc.)
- *      or [parameter-stmt] (is PARAMETER etc.)
- *      or [format-stmt] (is FORMAT etc.)
- *      or [entry-stmt] (is ENTRY entry-name etc.)
- */
-static boolean parseImplicitPartStmt (tokenInfo *const token)
-{
-	boolean result = TRUE;
-	switch (token->keyword)
-	{
-		case KEYWORD_entry: parseEntryStmt (token); break;
-
-		case KEYWORD_implicit:
-		case KEYWORD_include:
-		case KEYWORD_parameter:
-		case KEYWORD_format:
-			skipToNextStatement (token);
-			break;
-
-		default: result = FALSE; break;
-	}
-	return result;
-}
-
-/*  specification-part is
- *      [use-stmt] ... (is USE module-name etc.)
- *      [implicit-part] (is [implicit-part-stmt] ... [implicit-stmt])
- *      [declaration-construct] ...
- */
-static boolean parseSpecificationPart (tokenInfo *const token)
-{
-	boolean result = FALSE;
-	while (skipStatementIfKeyword (token, KEYWORD_use))
-		result = TRUE;
-	while (parseImplicitPartStmt (token))
-		result = TRUE;
-	while (parseDeclarationConstruct (token))
-		result = TRUE;
-	return result;
-}
-
-/*  block-data is
- *      block-data-stmt (is BLOCK DATA [block-data-name]
- *          [specification-part]
- *          end-block-data-stmt (is END [BLOCK DATA [block-data-name]])
- */
-static void parseBlockData (tokenInfo *const token)
-{
-	Assert (isKeyword (token, KEYWORD_block));
-	readToken (token);
-	if (isKeyword (token, KEYWORD_data))
-	{
-		readToken (token);
-		if (isType (token, TOKEN_IDENTIFIER))
-			makeFortranTag (token, TAG_BLOCK_DATA);
-	}
-	ancestorPush (token);
-	skipToNextStatement (token);
-	parseSpecificationPart (token);
-	while (! isKeyword (token, KEYWORD_end))
-		skipToNextStatement (token);
-	readSubToken (token);
-	/* secondary token should be KEYWORD_NONE or KEYWORD_block token */
-	skipToNextStatement (token);
-	ancestorPop ();
-}
-
-/*  internal-subprogram-part is
- *      contains-stmt (is CONTAINS)
- *          internal-subprogram
- *          [internal-subprogram] ...
- *
- *  internal-subprogram
- *      is function-subprogram
- *      or subroutine-subprogram
- */
-static void parseInternalSubprogramPart (tokenInfo *const token)
-{
-	boolean done = FALSE;
-	if (isKeyword (token, KEYWORD_contains))
-		skipToNextStatement (token);
-	do
-	{
-		switch (token->keyword)
-		{
-			case KEYWORD_function:   parseFunctionSubprogram (token);   break;
-			case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
-			case KEYWORD_end:        done = TRUE;                       break;
-
-			default:
-				if (isSubprogramPrefix (token))
-					readToken (token);
-				else if (isTypeSpec (token))
-					parseTypeSpec (token);
-				else
-					readToken (token);
-				break;
-		}
-	} while (! done);
-}
-
-/*  module is
- *      module-stmt (is MODULE module-name)
- *          [specification-part]
- *          [module-subprogram-part]
- *          end-module-stmt (is END [MODULE [module-name]])
- *
- *  module-subprogram-part
- *      contains-stmt (is CONTAINS)
- *          module-subprogram
- *          [module-subprogram] ...
- *
- *  module-subprogram
- *      is function-subprogram
- *      or subroutine-subprogram
- */
-static void parseModule (tokenInfo *const token)
-{
-	Assert (isKeyword (token, KEYWORD_module));
-	readToken (token);
-	if (isType (token, TOKEN_IDENTIFIER))
-		makeFortranTag (token, TAG_MODULE);
-	ancestorPush (token);
-	skipToNextStatement (token);
-	parseSpecificationPart (token);
-	if (isKeyword (token, KEYWORD_contains))
-		parseInternalSubprogramPart (token);
-	while (! isKeyword (token, KEYWORD_end))
-		skipToNextStatement (token);
-	readSubToken (token);
-	/* secondary token should be KEYWORD_NONE or KEYWORD_module token */
-	skipToNextStatement (token);
-	ancestorPop ();
-}
-
-/*  execution-part
- *      executable-construct
- *
- *  executable-contstruct is
- *      execution-part-construct [execution-part-construct]
- *
- *  execution-part-construct
- *      is executable-construct
- *      or format-stmt
- *      or data-stmt
- *      or entry-stmt
- */
-static boolean parseExecutionPart (tokenInfo *const token)
-{
-	boolean result = FALSE;
-	boolean done = FALSE;
-	while (! done)
-	{
-		switch (token->keyword)
-		{
-			default:
-				if (isSubprogramPrefix (token))
-					readToken (token);
-				else
-					skipToNextStatement (token);
-				result = TRUE;
-				break;
-
-			case KEYWORD_entry:
-				parseEntryStmt (token);
-				result = TRUE;
-				break;
-
-			case KEYWORD_contains:
-			case KEYWORD_function:
-			case KEYWORD_subroutine:
-				done = TRUE;
-				break;
-
-			case KEYWORD_end:
-				readSubToken (token);
-				if (isSecondaryKeyword (token, KEYWORD_do) ||
-					isSecondaryKeyword (token, KEYWORD_if) ||
-					isSecondaryKeyword (token, KEYWORD_select) ||
-					isSecondaryKeyword (token, KEYWORD_where))
-				{
-					skipToNextStatement (token);
-					result = TRUE;
-				}
-				else
-					done = TRUE;
-				break;
-		}
-	}
-	return result;
-}
-
-static void parseSubprogram (tokenInfo *const token, const tagType tag)
-{
-	Assert (isKeyword (token, KEYWORD_program) ||
-			isKeyword (token, KEYWORD_function) ||
-			isKeyword (token, KEYWORD_subroutine));
-	readToken (token);
-	if (isType (token, TOKEN_IDENTIFIER))
-		makeFortranTag (token, tag);
-	ancestorPush (token);
-	skipToNextStatement (token);
-	parseSpecificationPart (token);
-	parseExecutionPart (token);
-	if (isKeyword (token, KEYWORD_contains))
-		parseInternalSubprogramPart (token);
-	/* should be at KEYWORD_end token */
-	readSubToken (token);
-	/* secondary token should be one of KEYWORD_NONE, KEYWORD_program,
-	 * KEYWORD_function, KEYWORD_function
-	 */
-	skipToNextStatement (token);
-	ancestorPop ();
-}
-
-
-/*  function-subprogram is
- *      function-stmt (is [prefix] FUNCTION function-name etc.)
- *          [specification-part]
- *          [execution-part]
- *          [internal-subprogram-part]
- *          end-function-stmt (is END [FUNCTION [function-name]])
- *
- *  prefix
- *      is type-spec [RECURSIVE]
- *      or [RECURSIVE] type-spec
- */
-static void parseFunctionSubprogram (tokenInfo *const token)
-{
-	parseSubprogram (token, TAG_FUNCTION);
-}
-
-/*  subroutine-subprogram is
- *      subroutine-stmt (is [RECURSIVE] SUBROUTINE subroutine-name etc.)
- *          [specification-part]
- *          [execution-part]
- *          [internal-subprogram-part]
- *          end-subroutine-stmt (is END [SUBROUTINE [function-name]])
- */
-static void parseSubroutineSubprogram (tokenInfo *const token)
-{
-	parseSubprogram (token, TAG_SUBROUTINE);
-}
-
-/*  main-program is
- *      [program-stmt] (is PROGRAM program-name)
- *          [specification-part]
- *          [execution-part]
- *          [internal-subprogram-part ]
- *          end-program-stmt
- */
-static void parseMainProgram (tokenInfo *const token)
-{
-	parseSubprogram (token, TAG_PROGRAM);
-}
-
-/*  program-unit
- *      is main-program
- *      or external-subprogram (is function-subprogram or subroutine-subprogram)
- *      or module
- *      or block-data
- */
-static void parseProgramUnit (tokenInfo *const token)
-{
-	readToken (token);
-	do
-	{
-		if (isType (token, TOKEN_STATEMENT_END))
-			readToken (token);
-		else switch (token->keyword)
-		{
-			case KEYWORD_block:      parseBlockData (token);            break;
-			case KEYWORD_end:        skipToNextStatement (token);       break;
-			case KEYWORD_function:   parseFunctionSubprogram (token);   break;
-			case KEYWORD_module:     parseModule (token);               break;
-			case KEYWORD_program:    parseMainProgram (token);          break;
-			case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
-
-			default:
-				if (isSubprogramPrefix (token))
-					readToken (token);
-				else
-				{
-					boolean one = parseSpecificationPart (token);
-					boolean two = parseExecutionPart (token);
-					if (! (one || two))
-						readToken (token);
-				}
-				break;
-		}
-	} while (TRUE);
-}
-
-static boolean findFortranTags (const unsigned int passCount)
-{
-	tokenInfo *token;
-	exception_t exception;
-	boolean retry;
-
-	Assert (passCount < 3);
-	Parent = newToken ();
-	token = newToken ();
-	FreeSourceForm = (boolean) (passCount > 1);
-	Column = 0;
-	exception = (exception_t) setjmp (Exception);
-	if (exception == ExceptionEOF)
-		retry = FALSE;
-	else if (exception == ExceptionFixedFormat  &&  ! FreeSourceForm)
-	{
-		verbose ("%s: not fixed source form; retry as free source form\n",
-				getInputFileName ());
-		retry = TRUE;
-	}
-	else
-	{
-		parseProgramUnit (token);
-		retry = FALSE;
-	}
-	ancestorClear ();
-	deleteToken (token);
-	deleteToken (Parent);
-
-	return retry;
-}
-
-static void initialize (const langType language)
-{
-	Lang_fortran = language;
-	buildFortranKeywordHash ();
-}
-
-extern parserDefinition* FortranParser (void)
-{
-	static const char *const extensions [] = {
-		"f", "for", "ftn", "f77", "f90", "f95",
-#ifndef CASE_INSENSITIVE_FILENAMES
-		"F", "FOR", "FTN", "F77", "F90", "F95",
-#endif
-		NULL
-	};
-	parserDefinition* def = parserNew ("Fortran");
-	def->kinds      = FortranKinds;
-	def->kindCount  = KIND_COUNT (FortranKinds);
-	def->extensions = extensions;
-	def->parser2    = findFortranTags;
-	def->initialize = initialize;
-	return def;
-}
-
-/* vi:set tabstop=4 shiftwidth=4: */