SF.net SVN: geany:[3527] trunk
eht16 at users.sourceforge.net
eht16 at xxxxx
Thu Jan 29 17:24:31 UTC 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.
More information about the Commits
mailing list