SF.net SVN: geany:[3527] trunk - Commits

29 Jan 2009

Revision: 3527
          http://geany.svn.sourceforge.net/geany/?rev=3527&view=rev
Author:   eht16
Date:     2009-01-29 17:24:31 +0000 (Thu, 29 Jan 2009)
Log Message:
-----------
Update Fortran parser from CTags SVN (closes #2545000).
Modified Paths:
--------------
    trunk/ChangeLog
    trunk/tagmanager/fortran.c
Modified: trunk/ChangeLog
===================================================================

--- trunk/ChangeLog	2009-01-29 16:29:59 UTC (rev 3526)
+++ trunk/ChangeLog	2009-01-29 17:24:31 UTC (rev 3527)
@@ -2,6 +2,8 @@
* autogen.sh:
    Add a check for 'libtoolize' (suggested by Greg Smith, thanks).
+ * tagmanager/fortran.c:
+   Update Fortran parser from CTags SVN (closes #2545000).
2009-01-28  Enrico Tröger  <enrico(dot)troeger(at)uvena(dot)de>
Modified: trunk/tagmanager/fortran.c
===================================================================
--- trunk/tagmanager/fortran.c	2009-01-29 16:29:59 UTC (rev 3526)
+++ trunk/tagmanager/fortran.c	2009-01-29 17:24:31 UTC (rev 3527)
@@ -1,6 +1,7 @@
 /*
+*   $Id$
 *
-*   Copyright (c) 1998-2001, Darren Hiebert
+*   Copyright (c) 1998-2003, Darren Hiebert
 *
 *   This source code is released for free distribution under the terms of the
 *   GNU General Public License.
@@ -30,132 +31,159 @@
 /*
 *   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 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
+	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
+	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_block,
-    KEYWORD_character,
-    KEYWORD_common,
-    KEYWORD_complex,
-    KEYWORD_contains,
-    KEYWORD_data,
-    KEYWORD_dimension,
-    KEYWORD_do,
-    KEYWORD_double,
-    KEYWORD_end,
-    KEYWORD_entry,
-    KEYWORD_equivalence,
-    KEYWORD_external,
-    KEYWORD_format,
-    KEYWORD_function,
-    KEYWORD_if,
-    KEYWORD_implicit,
-    KEYWORD_include,
-    KEYWORD_integer,
-    KEYWORD_intent,
-    KEYWORD_interface,
-    KEYWORD_intrinsic,
-    KEYWORD_logical,
-    KEYWORD_module,
-    KEYWORD_namelist,
-    KEYWORD_operator,
-    KEYWORD_optional,
-    KEYWORD_parameter,
-    KEYWORD_pointer,
-    KEYWORD_precision,
-    KEYWORD_private,
-    KEYWORD_program,
-    KEYWORD_public,
-    KEYWORD_real,
-    KEYWORD_recursive,
-    KEYWORD_save,
-    KEYWORD_select,
-    KEYWORD_sequence,
-    KEYWORD_subroutine,
-    KEYWORD_target,
-    KEYWORD_type,
-    KEYWORD_use,
-    KEYWORD_where
+	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;
+	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_STATEMENT_END,
-    TOKEN_STRING
+	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 */
+	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;
-    unsigned long lineNumber;
-    fpos_t filePosition;
-    int	bufferPosition;	/* buffer position of line containing name */
+	tokenType type;
+	keywordId keyword;
+	tagType tag;
+	vString* string;
+	struct sTokenInfo *secondary;
+	unsigned long lineNumber;
+	fpos_t filePosition;
+	int bufferPosition;	/* buffer position of line containing name */
 } tokenInfo;
/*
@@ -168,84 +196,118 @@
 static int Ungetc = '\0';
 static unsigned int Column = 0;
 static boolean FreeSourceForm = FALSE;
+static boolean ParsingString;
 static tokenInfo *Parent = NULL;
/* indexed by tagType */
 static kindOption FortranKinds [] = {
-    { TRUE,  'b', "block data", "block data"},
-    { TRUE,  'c', "macro",      "common blocks"},
-    { TRUE,  'e', "entry",      "entry points"},
-    { TRUE,  'f', "function",   "functions"},
-    { TRUE,  'i', "struct",     "interfaces"},
-    { TRUE,  'k', "component",  "type components"},
-    { TRUE,  'l', "label",      "labels"},
-    { FALSE, 'L', "local",      "local and common block variables"},
-    { TRUE,  'm', "namespace",  "modules"},
-    { TRUE,  'n', "namelist",   "namelists"},
-    { TRUE,  'p', "package",    "programs"},
-    { TRUE,  's', "member",     "subroutines"},
-    { TRUE,  't', "typedef",    "derived types"},
-    { TRUE,  'v', "variable",   "module variables"}
+	{ TRUE,  'b', "block data",	"block data"},
+	{ TRUE,  'c', "macro",		"common blocks"},
+	{ TRUE,  'e', "entry",		"entry points"},
+	{ TRUE,  'f', "function",	"functions"},
+	{ FALSE, 'i', "struct",		"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', "namespace",	"modules"},
+	{ TRUE,  'n', "namelist",	"namelists"},
+	{ TRUE,  'p', "package",	"programs"},
+	{ TRUE,  's', "member",	"subroutines"},
+	{ TRUE,  't', "typedef",	"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	},
-    { "block",		KEYWORD_block		},
-    { "character",	KEYWORD_character	},
-    { "common",		KEYWORD_common		},
-    { "complex",	KEYWORD_complex		},
-    { "contains",	KEYWORD_contains	},
-    { "data",		KEYWORD_data		},
-    { "dimension",	KEYWORD_dimension	},
-    { "do",		KEYWORD_do		},
-    { "double",		KEYWORD_double		},
-    { "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		},
-    { "instrinsic",	KEYWORD_intrinsic	},
-    { "integer",	KEYWORD_integer		},
-    { "intent",		KEYWORD_intent		},
-    { "interface",	KEYWORD_interface	},
-    { "logical",	KEYWORD_logical		},
-    { "module",		KEYWORD_module		},
-    { "namelist",	KEYWORD_namelist	},
-    { "operator",	KEYWORD_operator	},
-    { "optional",	KEYWORD_optional	},
-    { "parameter",	KEYWORD_parameter	},
-    { "pointer",	KEYWORD_pointer		},
-    { "precision",	KEYWORD_precision	},
-    { "private",	KEYWORD_private		},
-    { "program",	KEYWORD_program		},
-    { "public",		KEYWORD_public		},
-    { "real",		KEYWORD_real		},
-    { "recursive",	KEYWORD_recursive	},
-    { "save",		KEYWORD_save		},
-    { "select",		KEYWORD_select		},
-    { "sequence",	KEYWORD_sequence	},
-    { "subroutine",	KEYWORD_subroutine	},
-    { "target",		KEYWORD_target		},
-    { "type",		KEYWORD_type		},
-    { "use",		KEYWORD_use		},
-    { "where",		KEYWORD_where		}
+	/* 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;
+	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);
@@ -256,118 +318,187 @@
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++;
+	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);
+	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].tag        = TAG_UNDEFINED;
-    Ancestors.list [Ancestors.count].string     = NULL;
-    Ancestors.list [Ancestors.count].lineNumber = 0L;
+	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];
+	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;
+	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 (const langType language)
 {
-    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, language, (int) p->id);
-    }
+	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, language, (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 ();
+	if (useFile())
+	    token->filePosition = getInputFilePosition ();
+	else
+	    token->bufferPosition = getInputBufferPosition ();
+
+	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);
+	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;
+	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;
+	token->tag = tag;
+	if (includeTag (token->tag))
+	{
+		const char *const name = vStringValue (token->string);
+		tagEntryInfo e;
-	initTagEntry (&e, name);
+		initTagEntry (&e, name);
-	if (token->tag == TAG_COMMON_BLOCK)
-	    e.lineNumberEntry = (boolean) (Option.locate != EX_PATTERN);
+		if (token->tag == TAG_COMMON_BLOCK)
+			e.lineNumberEntry = (boolean) (Option.locate != EX_PATTERN);
-	e.lineNumber	= token->lineNumber;
-	if (useFile())
-	    e.filePosition   = token->filePosition;
-	else
-	    e.bufferPosition = token->bufferPosition;
-	e.isFileScope	= isFileScope (token->tag);
-	e.kindName	= FortranKinds [token->tag].name;
-	e.kind		= FortranKinds [token->tag].letter;
-	e.truncateLine	= (boolean) (token->tag != TAG_LABEL);
+		e.lineNumber	= token->lineNumber;
+		if (useFile())
+		    e.filePosition   = token->filePosition;
+		else
+		    e.bufferPosition = token->bufferPosition;
+		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 parent = ancestorTop ();
-	    e.extensionFields.scope [0] = FortranKinds [parent->tag].name;
-	    e.extensionFields.scope [1] = vStringValue (parent->string);
+		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);
    }
-	makeTagEntry (&e);
-    }
 }
/*
@@ -376,252 +507,265 @@
static int skipLine (void)
 {
-    int c;
+	int c;
-    do
-	c = fileGetc ();
-    while (c != EOF  &&  c != '\n');
+	do
+		c = fileGetc ();
+	while (c != EOF  &&  c != '\n');
-    return c;
+	return c;
 }
static void makeLabelTag (vString *const label)
 {
-    tokenInfo token;
-
-    token.type		= TOKEN_LABEL;
-    token.keyword	= KEYWORD_NONE;
-    token.tag		= TAG_LABEL;
-    token.string	= label;
-    token.lineNumber	= getSourceLineNumber ();
-    if (useFile())
-	token.filePosition = getInputFilePosition ();
-    else
-	token.bufferPosition = getInputBufferPosition ();
-
-    makeFortranTag (&token, TAG_LABEL);
+	tokenInfo *token = newToken ();
+	token->type  = TOKEN_LABEL;
+	vStringCopy (token->string, label);
+	makeFortranTag (token, TAG_LABEL);
+	deleteToken (token);
 }
static lineType getLineType (void)
 {
-    static vString *label = NULL;
-    int column = 0;
-    lineType type = LTYPE_UNDETERMINED;
+	vString *label = vStringNew ();
+	int column = 0;
+	lineType type = LTYPE_UNDETERMINED;
-    if (label == NULL)
-	label = vStringNew ();
+	do  /* read in first 6 "margin" characters */
+	{
+		int c = fileGetc ();
-    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.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 '#' in column 1 as comment to permit preprocessor directives.
-	 */
-	if (column == 0  &&  strchr ("*Cc!#", 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;
-	    /* 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);
-	++column;
-    } while (column < 6  &&  type == LTYPE_UNDETERMINED);
+	Assert (type != LTYPE_UNDETERMINED);
-    Assert (type != LTYPE_UNDETERMINED);
-
-    if (vStringLength (label) > 0)
-    {
-	vStringTerminate (label);
-	makeLabelTag (label);
-	vStringClear (label);
-    }
-    return type;
+	if (vStringLength (label) > 0)
+	{
+		vStringTerminate (label);
+		makeLabelTag (label);
+	}
+	vStringDelete (label);
+	return type;
 }
static int getFixedFormChar (void)
 {
-    boolean newline = FALSE;
-    lineType type;
-    int c = '\0';
+	boolean newline = FALSE;
+	lineType type;
+	int c = '\0';
-    if (Column > 0)
-    {
+	if (Column > 0)
+	{
 #ifdef STRICT_FIXED_FORM
-	/*  EXCEPTION! Some compilers permit more than 72 characters per line.
-	 */
-	if (Column > 71)
-	    c = skipLine ();
-	else
+		/*  EXCEPTION! Some compilers permit more than 72 characters per line.
+		 */
+		if (Column > 71)
+			c = skipLine ();
+		else
 #endif
-	{
-	    c = fileGetc ();
-	    ++Column;
+		{
+			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);
+		}
    }
-	if (c == '\n')
+	while (Column == 0)
    {
-	    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;
+		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_SHORT: break;
+			case LTYPE_COMMENT: skipLine (); break;
-	    case LTYPE_EOF:
-		Column = 6;
-		if (newline)
-		    c = '\n';
-		else
-		    c = EOF;
-		break;
+			case LTYPE_EOF:
+				Column = 6;
+				if (newline)
+					c = '\n';
+				else
+					c = EOF;
+				break;
-	    case LTYPE_INITIAL:
-		if (newline)
-		{
-		    c = '\n';
-		    Column = 6;
-		    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);
    	}
-		/* 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;
+	return c;
 }
static int skipToNextLine (void)
 {
-    int c = skipLine ();
-    if (c != EOF)
-	c = fileGetc ();
-    return c;
+	int c = skipLine ();
+	if (c != EOF)
+		c = fileGetc ();
+	return c;
 }
static int getFreeFormChar (void)
 {
-    static boolean newline = TRUE;
-    boolean recurse = FALSE;
-    int c = fileGetc ();
+	static boolean newline = TRUE;
+	boolean advanceLine = FALSE;
+	int c = fileGetc ();
-    if (c == '&')		/* handle line continuation */
-    {
-	recurse = TRUE;
-	c = fileGetc ();
-    }
-    else if (newline && (c == '!' || c == '#'))
-	recurse = TRUE;
-    while (recurse)
-    {
-	while (isspace (c))
-	    c = fileGetc ();
-	while (c == '!' || (newline && c == '#'))
+	/* 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 == '&')
    {
-	    c = skipToNextLine ();
-	    newline = TRUE;
+		do
+			c = fileGetc ();
+		while (isspace (c)  &&  c != '\n');
+		if (c == '\n')
+		{
+			newline = TRUE;
+			advanceLine = TRUE;
+		}
+		else if (c == '!')
+			advanceLine = TRUE;
+		else
+		{
+			fileUngetc (c);
+			c = '&';
+		}
    }
-	if (c == '&')
-	    c = fileGetc ();
-	else
-	    recurse = FALSE;
-    }
-    newline = (boolean) (c == '\n');
-    return 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;
+	int c;
-    if (Ungetc != '\0')
-    {
-	c = Ungetc;
-	Ungetc = '\0';
-    }
-    else if (FreeSourceForm)
-	c = getFreeFormChar ();
-    else
-	c = getFixedFormChar ();
-
-    return 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;
+	Ungetc = c;
 }
/*  If a numeric is passed in 'c', this is used as the first digit of the
@@ -629,131 +773,138 @@
  */
 static vString *parseInteger (int c)
 {
-    static vString *string = NULL;
+	vString *string = vStringNew ();
-    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 == '-')
-    {
-	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);
-    if (c == '_')
-    {
-	do
-	    c = getChar ();
-	while (c != EOF  &&  isalpha (c));
-    }
-    ungetChar (c);
-
-    return string;
+	return string;
 }
static vString *parseNumeric (int c)
 {
-    static vString *string = NULL;
+	vString *string = vStringNew ();
+	vString *integer = parseInteger (c);
+	vStringCopy (string, integer);
+	vStringDelete (integer);
-    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);
+	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);
+	vStringTerminate (string);
-    return string;
+	return string;
 }
-static void parseString (vString *const string, const int delimeter)
+static void parseString (vString *const string, const int delimiter)
 {
-    const unsigned long inputLineNumber = getInputLineNumber ();
-    int c = getChar ();
-
-    while (c != delimeter  &&  c != '\n'  &&  c != EOF)
-    {
-	vStringPut (string, c);
+	const unsigned long inputLineNumber = getInputLineNumber ();
+	int c;
+	ParsingString = TRUE;
    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);
+	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;
+	int c = firstChar;
-    do
-    {
-	vStringPut (string, c);
-	c = getChar ();
-    } while (isident (c));
+	do
+	{
+		vStringPut (string, c);
+		c = getChar ();
+	} while (isident (c));
-    vStringTerminate (string);
-    ungetChar (c);		/* unget non-identifier character */
+	vStringTerminate (string);
+	ungetChar (c);  /* unget non-identifier character */
 }
-static tokenInfo *newToken (void)
+static void checkForLabel (void)
 {
-    tokenInfo *const token = xMalloc (1, tokenInfo);
+	tokenInfo* token = NULL;
+	int length;
+	int c;
-    token->type	   = TOKEN_UNDEFINED;
-    token->keyword = KEYWORD_NONE;
-    token->tag	   = TAG_UNDEFINED;
-    token->string  = vStringNew ();
-    token->lineNumber   = getSourceLineNumber ();
-    if (useFile())
-	token->filePosition = getInputFilePosition ();
-    else
-	token->bufferPosition = getInputBufferPosition ();
+	do
+		c = getChar ();
+	while (isBlank (c));
-    return token;
+	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 deleteToken (tokenInfo *const token)
-{
-    vStringDelete (token->string);
-    eFree (token);
-}
-
 /*  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 keywordId analyzeToken (vString *const name, langType language)
 {
     static vString *keyword = NULL;
     keywordId id;
@@ -761,205 +912,253 @@
     if (keyword == NULL)
    keyword = vStringNew ();
     vStringCopyToLower (keyword, name);
-    id = (keywordId) lookupKeyword (vStringValue (keyword), getSourceLanguage());
+    id = (keywordId) lookupKeyword (vStringValue (keyword), language);
return id;
 }
-static void checkForLabel (void)
+static void readIdentifier (tokenInfo *const token, const int c)
 {
-    tokenInfo* token = NULL;
-    int length;
-    int c;
-
-    do
-	c = getChar ();
-    while (isBlank (c));
-
-    for (length = 0  ;  isdigit (c)  &&  length < 5  ;  ++length)
-    {
-	if (token == NULL)
+	parseIdentifier (token->string, c);
+	token->keyword = analyzeToken (token->string, Lang_fortran);
+	if (! isKeyword (token, KEYWORD_NONE))
+		token->type = TOKEN_KEYWORD;
+	else
    {
-	    token = newToken ();
-	    token->type = TOKEN_LABEL;
+		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;
+			}
+		}
    }
-	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 readToken (tokenInfo *const token)
 {
-    int c;
+	int c;
-    token->type    = TOKEN_UNDEFINED;
-    token->tag     = TAG_UNDEFINED;
-    token->keyword = KEYWORD_NONE;
-    vStringClear (token->string);
+	deleteToken (token->secondary);
+	token->type        = TOKEN_UNDEFINED;
+	token->tag         = TAG_UNDEFINED;
+	token->keyword     = KEYWORD_NONE;
+	token->secondary   = NULL;
+	vStringClear (token->string);
getNextChar:
-    token->lineNumber	= getSourceLineNumber ();
-    if (useFile())
-	token->filePosition = getInputFilePosition ();
-    else
-	token->bufferPosition = getInputBufferPosition ();
+	c = getChar ();
-    c = getChar ();
+	token->lineNumber	= getSourceLineNumber ();
+	if (useFile())
+	    token->filePosition = getInputFilePosition ();
+	else
+	    token->bufferPosition = getInputBufferPosition ();
-    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 '*':
-	case '/':
-	case '+':
-	case '-':
-	case '=':
-	case '<':
-	case '>':
+	switch (c)
    {
-	    const char *const operatorChars = "*/+-=<>";
+		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;
-	    do {
-		vStringPut (token->string, c);
-		c = getChar ();
-	    } while (strchr (operatorChars, c) != NULL);
-	    ungetChar (c);
-	    vStringTerminate (token->string);
-	    token->type = TOKEN_OPERATOR;
-	    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 '!':
+			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 '.':
+			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 ':':
-	    if (getChar () == ':')
-		token->type = TOKEN_DOUBLE_COLON;
-	    else
-		token->type = TOKEN_UNDEFINED;
-	    break;
+		case '"':
+		case ''':
+			parseString (token->string, c);
+			token->type = TOKEN_STRING;
+			break;
-	default:
-	    if (isalpha (c))
-	    {
-		parseIdentifier (token->string, c);
-		token->keyword = analyzeToken (token->string);
-		if (isKeyword (token, KEYWORD_NONE))
-		    token->type = TOKEN_IDENTIFIER;
-		else
-		    token->type = TOKEN_KEYWORD;
-	    }
-	    else if (isdigit (c))
-	    {
-		vStringCat (token->string, parseNumeric (c));
-		token->type = TOKEN_NUMERIC;
-	    }
-	    else if (c == '"'  ||  c == ''')
-	    {
-		parseString (token->string, c);
-		token->type = TOKEN_STRING;
-	    }
-	    else if (c == ';'  &&  FreeSourceForm)
-		token->type = TOKEN_STATEMENT_END;
-	    else
-		token->type = TOKEN_UNDEFINED;
-	    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))
-	readToken (token);
+	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);
+	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));
+	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_integer:
-	case KEYWORD_real:
-	case KEYWORD_double:
-	case KEYWORD_complex:
-	case KEYWORD_character:
-	case KEYWORD_logical:
-	case KEYWORD_type:
-	    result = TRUE;
-	    break;
-	default:
-	    result = FALSE;
-	    break;
-    }
-    return result;
+	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. )
@@ -973,79 +1172,84 @@
  */
 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_integer:
-	case KEYWORD_real:
-	case KEYWORD_complex:
-	case KEYWORD_character:
-	case KEYWORD_logical:
-	    readToken (token);
-	    if (isType (token, TOKEN_PAREN_OPEN))
-		skipPast (token, TOKEN_PAREN_CLOSE); /* skip kind-selector */
-	    else if (isType (token, TOKEN_OPERATOR) &&
-		     strcmp (vStringValue (token->string), "*") == 0)
-	    {
-		readToken (token);
-		readToken (token);
-	    }
-	    break;
+	/* 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_double:
-	    readToken (token);
-	    if (! isKeyword (token, KEYWORD_precision))
-		skipToToken (token, TOKEN_STATEMENT_END);
-	    break;
-	case KEYWORD_type:
-	    readToken (token);
-	    if (isType (token, TOKEN_PAREN_OPEN))
-		skipPast (token, TOKEN_PAREN_CLOSE); /* skip type-name */
-	    else
-		parseDerivedTypeDef (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;
-	default:
-	    skipToToken (token, TOKEN_STATEMENT_END);
-	    break;
-    }
-}
+		case KEYWORD_double:
+			readToken (token);
+			if (isKeyword (token, KEYWORD_complex) ||
+				isKeyword (token, KEYWORD_precision))
+					readToken (token);
+			else
+				skipToToken (token, TOKEN_STATEMENT_END);
+			break;
-/* skip over parenthesis enclosed contents starting at next token.
- * Token refers to 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)
-{
-    if (isType (token, TOKEN_PAREN_OPEN))
-	skipPast (token, TOKEN_PAREN_CLOSE);
+		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;
+	boolean result = FALSE;
+	if (isKeyword (token, keyword))
+	{
+		result = TRUE;
+		skipToNextStatement (token);
+	}
+	return result;
 }
-static boolean isMatchingEnd (tokenInfo *const token, keywordId keyword)
-{
-    boolean result = FALSE;
-    if (isKeyword (token, KEYWORD_end))
-    {
-	readToken (token);
-	result = (boolean) (isKeyword (token, KEYWORD_NONE) ||
-			    isKeyword (token, keyword));
-    }
-    return result;
-}
-
 /* parse a list of qualifying specifiers, leaving `token' at first token
  * following list. Examples of such specifiers are:
  *      [[, attr-spec] ::]
@@ -1070,111 +1274,306 @@
  */
 static void parseQualifierSpecList (tokenInfo *const token)
 {
-    do
-    {
-	readToken (token);	/* should be an attr-spec */
-	switch (token->keyword)
+	do
    {
-	    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;
+		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;
+			case KEYWORD_dimension:
+			case KEYWORD_intent:
+				readToken (token);
+				skipOverParens (token);
+				break;
-	    default: skipToToken (token, TOKEN_STATEMENT_END); 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;
+		}
    }
-    } while (isType (token, TOKEN_COMMA));
-    if (! isType (token, TOKEN_DOUBLE_COLON))
-	skipToToken (token, TOKEN_STATEMENT_END);
+	return result;
 }
-static boolean localVariableScope (void)
+static void parseEntityDecl (tokenInfo *const token)
 {
-    boolean result = TRUE;
-    if (ancestorCount () > 0)
-    {
-	const tokenInfo* const parent = ancestorTop ();
-	result = (boolean) (parent->tag != TAG_MODULE);
-    }
-    return result;
+	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)
 {
-    const tagType tag = localVariableScope () ? TAG_LOCAL : TAG_VARIABLE;
-    Assert (isTypeSpec (token));
-    parseTypeSpec (token);
-    if (isType (token, TOKEN_COMMA))
-	parseQualifierSpecList (token);
-    if (isType (token, TOKEN_DOUBLE_COLON))
-	readToken (token);
-    do
-    {
-	if (isType (token, TOKEN_IDENTIFIER))
-	    makeFortranTag (token, tag);
-	skipPast (token, TOKEN_COMMA);
-    } while (! isType (token, TOKEN_STATEMENT_END));
-    skipToNextStatement (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);
 }
-static void parseParenName (tokenInfo *const 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)
 {
-    readToken (token);
-    if (isType (token, TOKEN_PAREN_OPEN))
+	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);
 }
-/*  common-stmt is
- *      COMMON [/[common-block-name]/] common-block-object-list [[,]/[common-block-name]/ common-block-object-list] ...
+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
+ *      *
  *
- *  common-block-object is
- *      variable-name [ ( explicit-shape-spec-list ) ]
+ *  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 parseCommonStmt (tokenInfo *const token)
+static void parseUnionStmt (tokenInfo *const token)
 {
-    Assert (isKeyword (token, KEYWORD_common));
-    readToken (token);
-    do
-    {
-	if (isType (token, TOKEN_OPERATOR))
-	{
-	    readToken (token);
-	    if (isType (token, TOKEN_IDENTIFIER))
-		makeFortranTag (token, TAG_COMMON_BLOCK);
-	    skipPast (token, TOKEN_OPERATOR);
-	}
-	if (isType (token, TOKEN_IDENTIFIER))
-	    makeFortranTag (token, TAG_LOCAL);
-	skipPast (token, TOKEN_COMMA);
-    } while (! isType (token, TOKEN_STATEMENT_END));
-    skipToNextStatement (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);
 }
-static void tagSlashName (tokenInfo *const token, const tagType type)
+/*  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)
 {
-    readToken (token);
-    if (isType (token, TOKEN_OPERATOR))
-    {
+	tokenInfo *name;
+	Assert (isKeyword (token, KEYWORD_structure));
    readToken (token);
-	if (isType (token, TOKEN_IDENTIFIER))
-	    makeFortranTag (token, type);
-    }
+	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
@@ -1197,37 +1596,42 @@
  */
 static boolean parseSpecificationStmt (tokenInfo *const token)
 {
-    boolean result = TRUE;
-    switch (token->keyword)
-    {
-	case KEYWORD_common: parseCommonStmt (token); break;
+	boolean result = TRUE;
+	switch (token->keyword)
+	{
+		case KEYWORD_common:
+			parseCommonNamelistStmt (token, TAG_COMMON_BLOCK);
+			break;
-	case KEYWORD_namelist:
-	    tagSlashName (token, TAG_NAMELIST);
-	    skipToNextStatement (token);
-	    break;
+		case KEYWORD_namelist:
+			parseCommonNamelistStmt (token, TAG_NAMELIST);
+			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;
+		case KEYWORD_structure:
+			parseStructureStmt (token);
+			break;
-	default:
-	    result = FALSE;
-	    break;
-    }
-    return result;
+		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
@@ -1238,19 +1642,13 @@
  */
 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);
-    do
-    {
-	if (isType (token, TOKEN_IDENTIFIER))
-	    makeFortranTag (token, TAG_COMPONENT);
-	skipPast (token, TOKEN_COMMA);
-    } while (! isType (token, TOKEN_STATEMENT_END));
-    readToken (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
@@ -1262,27 +1660,30 @@
  */
 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))
-    {
+	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);
-    }
-    while (! isMatchingEnd (token, KEYWORD_type))
-    {
-	if (isTypeSpec (token))
-	    parseComponentDefStmt (token);
-	else
-	    skipToNextStatement (token);
-    }
-    ancestorPop ();
+	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
@@ -1309,20 +1710,55 @@
  */
 static void parseInterfaceBlock (tokenInfo *const token)
 {
-    readToken (token);
-    if (isType (token, TOKEN_IDENTIFIER))
-	makeFortranTag (token, TAG_INTERFACE);
-    else if (isKeyword (token, KEYWORD_assignment) ||
-	     isKeyword (token, KEYWORD_operator))
-    {
-	parseParenName (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;
-	if (isType (token, TOKEN_OPERATOR))
-	    makeFortranTag (token, TAG_INTERFACE);
-    }
-    while (! isMatchingEnd (token, KEYWORD_interface))
-	readToken (token);
-    skipToNextStatement (token);
+			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
@@ -1330,34 +1766,65 @@
  */
 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);
+	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
-  */
+/*  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);
+	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;
+	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]
@@ -1370,29 +1837,38 @@
  */
 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_format:    skipToNextStatement (token); break;
-	case KEYWORD_parameter: skipToNextStatement (token); break;
-	case KEYWORD_include:   skipToNextStatement (token); break;
-	/* derived type handled by parseTypeDeclarationStmt(); */
+	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(); */
-	default:
-	    if (isTypeSpec (token))
-	    {
-		parseTypeDeclarationStmt (token);
-		result = TRUE;
-	    }
-	    else if (isType (token, TOKEN_IDENTIFIER))
-		result = parseStmtFunctionStmt (token);
-	    else
-		result = parseSpecificationStmt (token);
-	    break;
-    }
-    return result;
+		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
@@ -1403,21 +1879,21 @@
  */
 static boolean parseImplicitPartStmt (tokenInfo *const token)
 {
-    boolean result = TRUE;
-    switch (token->keyword)
-    {
-	case KEYWORD_entry: parseEntryStmt (token); break;
+	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;
+		case KEYWORD_implicit:
+		case KEYWORD_include:
+		case KEYWORD_parameter:
+		case KEYWORD_format:
+			skipToNextStatement (token);
+			break;
-	default: result = FALSE; break;
-    }
-    return result;
+		default: result = FALSE; break;
+	}
+	return result;
 }
/*  specification-part is
@@ -1425,14 +1901,16 @@
  *      [implicit-part] (is [implicit-part-stmt] ... [implicit-stmt])
  *      [declaration-construct] ...
  */
-static void parseSpecificationPart (tokenInfo *const token)
+static boolean parseSpecificationPart (tokenInfo *const token)
 {
-    while (skipStatementIfKeyword (token, KEYWORD_use))
-	;
-    while (parseImplicitPartStmt (token))
-	;
-    while (parseDeclarationConstruct (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
@@ -1442,20 +1920,23 @@
  */
 static void parseBlockData (tokenInfo *const token)
 {
-    Assert (isKeyword (token, KEYWORD_block));
-    readToken (token);
-    if (isKeyword (token, KEYWORD_data))
-    {
+	Assert (isKeyword (token, KEYWORD_block));
    readToken (token);
-	makeFortranTag (token, TAG_BLOCK_DATA);
-    }
-    ancestorPush (token);
-    skipToNextStatement (token);
-    parseSpecificationPart (token);
-    while (! isMatchingEnd (token, KEYWORD_block))
-	readToken (token);
-    skipToNextStatement (token);
-    ancestorPop ();
+	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
@@ -1469,29 +1950,31 @@
  */
 static void parseInternalSubprogramPart (tokenInfo *const token)
 {
-    boolean done = FALSE;
-    Assert (isKeyword (token, KEYWORD_contains));
-    skipToNextStatement (token);
-    do
-    {
-	switch (token->keyword)
+	boolean done = FALSE;
+	if (isKeyword (token, KEYWORD_contains))
+		skipToNextStatement (token);
+	do
    {
-	    case KEYWORD_function:   parseFunctionSubprogram (token);   break;
-	    case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
-	    case KEYWORD_recursive:  readToken (token); break;
+		switch (token->keyword)
+		{
+			case KEYWORD_function:   parseFunctionSubprogram (token);   break;
+			case KEYWORD_subroutine: parseSubroutineSubprogram (token); break;
+			case KEYWORD_end:        done = TRUE;                       break;
-	    default:
-		if (isTypeSpec (token))
-		    parseTypeSpec (token);
-		else
-		    done = TRUE;
-		break;
-	}
-    } while (! done);
+			default:
+				if (isSubprogramPrefix (token))
+					readToken (token);
+				else if (isTypeSpec (token))
+					parseTypeSpec (token);
+				else
+					readToken (token);
+				break;
+		}
+	} while (! done);
 }
/*  module is
- *      mudule-stmt (is MODULE module-name)
+ *      module-stmt (is MODULE module-name)
  *          [specification-part]
  *          [module-subprogram-part]
  *          end-module-stmt (is END [MODULE [module-name]])
@@ -1507,23 +1990,25 @@
  */
 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 (! isMatchingEnd (token, KEYWORD_module))
+	Assert (isKeyword (token, KEYWORD_module));
    readToken (token);
-    skipToNextStatement (token);
-    ancestorPop ();
+	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-contstruct
+ *      executable-construct
  *
  *  executable-contstruct is
  *      execution-part-construct [execution-part-construct]
@@ -1534,32 +2019,72 @@
  *      or data-stmt
  *      or entry-stmt
  */
-static void parseExecutionPart (tokenInfo *const token, const keywordId keyword)
+static boolean parseExecutionPart (tokenInfo *const token)
 {
-    while (! isMatchingEnd (token, keyword))
-    {
-	readToken (token);
-	if (isKeyword (token, KEYWORD_contains))
-	    parseInternalSubprogramPart (token);
-	else if (isKeyword (token, KEYWORD_entry))
-	    parseEntryStmt (token);
-	skipOverParens (token);
-    }
-    skipToNextStatement (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 keywordId keyword, const tagType tag)
+static void parseSubprogram (tokenInfo *const token, const tagType tag)
 {
-    Assert (isKeyword (token, keyword));
-    readToken (token);
-    if (isType (token, TOKEN_IDENTIFIER))
-	makeFortranTag (token, tag);
-    ancestorPush (token);
-    skipToNextStatement (token);
-    parseSpecificationPart (token);
-    parseExecutionPart (token, keyword);
-    ancestorPop ();
+	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 ();
 }
@@ -1576,7 +2101,7 @@
  */
 static void parseFunctionSubprogram (tokenInfo *const token)
 {
-    parseSubprogram (token, KEYWORD_function, TAG_FUNCTION);
+	parseSubprogram (token, TAG_FUNCTION);
 }
/*  subroutine-subprogram is
@@ -1588,7 +2113,7 @@
  */
 static void parseSubroutineSubprogram (tokenInfo *const token)
 {
-    parseSubprogram (token, KEYWORD_subroutine, TAG_SUBROUTINE);
+	parseSubprogram (token, TAG_SUBROUTINE);
 }
/*  main-program is
@@ -1600,7 +2125,7 @@
  */
 static void parseMainProgram (tokenInfo *const token)
 {
-    parseSubprogram (token, KEYWORD_program, TAG_PROGRAM);
+	parseSubprogram (token, TAG_PROGRAM);
 }
/*  program-unit
@@ -1611,62 +2136,65 @@
  */
 static void parseProgramUnit (tokenInfo *const token)
 {
-    readToken (token);
-    do
-    {
-	if (isType (token, TOKEN_STATEMENT_END))
-	    readToken (token);
-	else switch (token->keyword)
+	readToken (token);
+	do
    {
-	    case KEYWORD_block:      parseBlockData (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;
-	    case KEYWORD_recursive:  readToken (token);                 break;
-	    default:
-		if (isTypeSpec (token))
-		    parseTypeSpec (token);
-		else
+		if (isType (token, TOKEN_STATEMENT_END))
+			readToken (token);
+		else switch (token->keyword)
    	{
-		    parseSpecificationPart (token);
-		    parseExecutionPart (token, KEYWORD_NONE);
+			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;
    	}
-		break;
-	}
-    } while (TRUE);
+	} while (TRUE);
 }
static boolean findFortranTags (const unsigned int passCount)
 {
-    tokenInfo *token;
-    exception_t exception;
-    boolean retry;
+	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);
+	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;
+	return retry;
 }
static void initializeFortran (const langType language)
@@ -1716,5 +2244,4 @@
     def->initialize = initializeF77;
     return def;
 }
-
-/* vi:set tabstop=8 shiftwidth=4: */
+/* vi:set tabstop=4 shiftwidth=4: */
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

    