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.