* Fortran: Handle fixed form code (enh. 534785) (14bc89af) · Commits · Elphel / doxverilog

src/fortrancode.l

+50 −0

Original line number	Original line	Diff line number	Diff line
	@@ -94,6 +94,7 @@ static int g_inputPosition; //!< read offset during parsing
	static int g_inputLines; //!< number of line in the code fragment		static int g_inputLines; //!< number of line in the code fragment
	static int g_yyLineNr; //!< current line number		static int g_yyLineNr; //!< current line number
	static bool g_needsTermination;		static bool g_needsTermination;
			static bool g_isFixedForm;

	static bool g_insideBody; //!< inside subprog/program body? => create links		static bool g_insideBody; //!< inside subprog/program body? => create links
	static const char * g_currentFontClass;		static const char * g_currentFontClass;
	@@ -109,6 +110,44 @@ static bool g_includeCodeFragment;

	static char stringStartSymbol; // single or double quote		static char stringStartSymbol; // single or double quote

			// simplified way to know if this is fixed form
			// duplicate in fortranscanner.l
			static bool recognizeFixedForm(const char* contents)
			{
			int column=0;
			bool skipLine=FALSE;

			for(int i=0;;i++) {
			column++;

			switch(contents[i]) {
			case '\n':
			column=0;
			skipLine=FALSE;
			break;
			case ' ':
			break;
			case '\000':
			return FALSE;
			case 'C':
			case 'c':
			case '*':
			if(column==1) return TRUE;
			if(skipLine) break;
			return FALSE;
			case '!':
			if(column>1 && column<7) return FALSE;
			skipLine=TRUE;
			break;
			default:
			if(skipLine) break;
			if(column==7) return TRUE;
			return FALSE;
			}
			}
			return FALSE;
			}

	static void endFontClass()		static void endFontClass()
	{		{
	if (g_currentFontClass)		if (g_currentFontClass)
	@@ -837,6 +876,15 @@ IGNORE (IMPLICIT{BS}NONE\|CONTAINS\|WRITE\|READ\|ALLOCATE\|DEALLOCATE\|SIZE)
	codifyLines(yytext);		codifyLines(yytext);
	endFontClass();		endFontClass();
	}		}

			<>^[Cc].* { // normal comment
			if(! g_isFixedForm) REJECT;

			startFontClass("comment");
			codifyLines(yytext);
			endFontClass();
			}

	/------ preprocessor --------------------------------------------/		/------ preprocessor --------------------------------------------/
	<Start>"#".*\n { startFontClass("preprocessor");		<Start>"#".*\n { startFontClass("preprocessor");
	codifyLines(yytext);		codifyLines(yytext);
	@@ -884,6 +932,7 @@ IGNORE (IMPLICIT{BS}NONE\|CONTAINS\|WRITE\|READ\|ALLOCATE\|DEALLOCATE\|SIZE)

	/===================================================================/		/===================================================================/


	void resetFortranCodeParserState() {}		void resetFortranCodeParserState() {}

	void parseFortranCode(CodeOutputInterface &od,const char *className,const QCString &s,		void parseFortranCode(CodeOutputInterface &od,const char *className,const QCString &s,
	@@ -901,6 +950,7 @@ void parseFortranCode(CodeOutputInterface &od,const char *className,const QCStri
	g_code = &od;		g_code = &od;
	g_inputString = s;		g_inputString = s;
	g_inputPosition = 0;		g_inputPosition = 0;
			g_isFixedForm = recognizeFixedForm((const char*)s);
	g_currentFontClass = 0;		g_currentFontClass = 0;
	g_needsTermination = FALSE;		g_needsTermination = FALSE;
	if (endLine!=-1)		if (endLine!=-1)

src/fortranscanner.l

+245 −50

Original line number	Original line	Diff line number	Diff line
	@@ -112,10 +112,18 @@ static const char *directionStrs[] =
	static ParserInterface *g_thisParser;		static ParserInterface *g_thisParser;
	static const char * inputString;		static const char * inputString;
	static int inputPosition;		static int inputPosition;
			static bool isFixedForm;
	static QCString inputStringPrepass; ///< Input string for prepass of line cont. '&'		static QCString inputStringPrepass; ///< Input string for prepass of line cont. '&'
	static unsigned int inputPositionPrepass;		static unsigned int inputPositionPrepass;
	static int lineCountPrepass = 0;		static int lineCountPrepass = 0;

			struct CommentInPrepass {
			int column;
			QCString str;
			CommentInPrepass(int column, QCString str) : column(column), str(str) {}
			};
			static QList<CommentInPrepass> comments;

	#define MAX_INCLUDE_DEPTH 10		#define MAX_INCLUDE_DEPTH 10
	YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];		YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
	int include_stack_ptr = 0;		int include_stack_ptr = 0;
	@@ -174,9 +182,12 @@ static bool endScope(Entry *scope, bool isGlobalRoot=FALSE);
	static QCString getFullName(Entry *e);		static QCString getFullName(Entry *e);
	static bool isTypeName(QCString name);		static bool isTypeName(QCString name);
	static void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root);		static void resolveModuleProcedures(QList<Entry> &moduleProcedures, Entry *current_root);
	static int getAmpersandAtTheEnd(const char *buf, int length);		static int getAmpersandAtTheStart(const char *buf, int length);
			static int getAmpOrExclAtTheEnd(const char *buf, int length);
			static void truncatePrepass(int index);
	static void pushBuffer(QCString &buffer);		static void pushBuffer(QCString &buffer);
	static void popBuffer();		static void popBuffer();
			static void extractPrefix(QCString& text);

	//-----------------------------------------------------------------------------		//-----------------------------------------------------------------------------
	#undef YY_INPUT		#undef YY_INPUT
	@@ -257,37 +268,45 @@ PREFIX (RECURSIVE{BS_}\|PURE{BS_}\|ELEMENTAL{BS_}){0,2}(RECURSIVE\|PURE\|ELEMENTA

	/-----------------------------------------------------------------------------------/		/-----------------------------------------------------------------------------------/

	<>^."&"{BS}(!.*)?\n { // ampersand is somewhere in line		<>^.\n { // prepass: look for line continuations

	//fprintf(stderr, "---%s", yytext);		//fprintf(stderr, "---%s", yytext);

	int index = getAmpersandAtTheEnd(yytext, yyleng);		int indexStart = getAmpersandAtTheStart(yytext, yyleng);
	if(index<0){ // ampersand is not line continuation		int indexEnd = getAmpOrExclAtTheEnd(yytext, yyleng);
			if (indexEnd>=0 && yytext[indexEnd]!='&') //we are only interested in amp
			indexEnd=-1;

			if(indexEnd<0){ // ----- no ampersand as line continuation
	if(YY_START == Prepass) { // last line in "continuation"		if(YY_START == Prepass) { // last line in "continuation"
	inputStringPrepass+=(const char*)yytext;		inputStringPrepass+=(const char*)yytext;
			if(indexStart>=0) inputStringPrepass[yyleng-indexStart]=' ';
			// @todo: remove all symbols instead of replacing W blank?

	pushBuffer(inputStringPrepass);		pushBuffer(inputStringPrepass);
	yy_pop_state();		yy_pop_state();
	} else { // simple line		} else { // simple line
	REJECT;		REJECT;
	}		}
	} else { // line with continuation
			} else { // ----- line with continuation
			if(YY_START != Prepass) {
			comments.setAutoDelete(TRUE);
			comments.clear();
			yy_push_state(Prepass);
			}

	inputStringPrepass+=(const char*)yytext;		inputStringPrepass+=(const char*)yytext;
	lineCountPrepass ++;		lineCountPrepass ++;

	// replace & with space and remove the following chars		// replace & with space and remove following comment if present
	int length = inputStringPrepass.length();		int length = inputStringPrepass.length();
	inputStringPrepass[length-yyleng+index] = ' ';		truncatePrepass(length-yyleng+indexEnd);
	inputStringPrepass.truncate(length-yyleng+index+1);
	if(YY_START != Prepass)
	yy_push_state(Prepass);
	}
	}		}

	<Prepass>^.*\n {
	inputStringPrepass+=(const char*)yytext;
	pushBuffer(inputStringPrepass);
	yy_pop_state();
	}		}


	/------ ignore strings /		/------ ignore strings /
	<>"\\\\" { / ignore \\ */}		<>"\\\\" { / ignore \\ */}
	<>"\\\""\|\\\' { / ignore \" and \' */}		<>"\\\""\|\\\' { / ignore \" and \' */}
	@@ -472,7 +491,7 @@ PREFIX (RECURSIVE{BS_}\|PURE{BS_}\|ELEMENTAL{BS_}){0,2}(RECURSIVE\|PURE\|ELEMENTA
	BEGIN(TypedefBody);		BEGIN(TypedefBody);
	}		}
	<TypedefBody>^{BS}"end"{BS}"type"({BS_}{ID})?{BS}/(\n\|!) { /* end type definition */		<TypedefBody>^{BS}"end"{BS}"type"({BS_}{ID})?{BS}/(\n\|!) { /* end type definition */
	//cout << "=========> got typedef end "<< endl;		//printf("=========> got typedef end \n");
	if (!endScope(current_root))		if (!endScope(current_root))
	yyterminate();		yyterminate();
	yy_pop_state();		yy_pop_state();
	@@ -639,23 +658,7 @@ PREFIX (RECURSIVE{BS_}\|PURE{BS_}\|ELEMENTAL{BS_}){0,2}(RECURSIVE\|PURE\|ELEMENTA
	// TYPE_SPEC is for old function style function result		// TYPE_SPEC is for old function style function result
	result= yytext;		result= yytext;
	result= result.stripWhiteSpace();		result= result.stripWhiteSpace();
	int prefixIndex = 0;		extractPrefix(result);
	int curIndex = 0;
	bool cont = TRUE;
	const char* pre[] = {"RECURSIVE","PURE","ELEMENTAL"};
	while(cont)
	{
	cont = FALSE;
	for(unsigned int i=0; i<3; i++)
	{
	if((prefixIndex=result.find(pre[i], curIndex, FALSE))==0)
	{
	result.remove(0,strlen(pre[i]));
	result.stripWhiteSpace();
	cont = TRUE;
	}
	}
	}
	//fprintf(stderr, "===%s\n", (const char*)result);		//fprintf(stderr, "===%s\n", (const char*)result);
	current->type = result;		current->type = result;
	yy_push_state(SubprogPrefix);		yy_push_state(SubprogPrefix);
	@@ -667,9 +670,12 @@ PREFIX (RECURSIVE{BS_}\|PURE{BS_}\|ELEMENTAL{BS_}){0,2}(RECURSIVE\|PURE\|ELEMENTA
	BEGIN(Subprog);		BEGIN(Subprog);
	}		}

	<Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}{SUBPROG}{BS_} {		<Start,ModuleBody,SubprogBody,InterfaceBody,ModuleBodyContains,SubprogBodyContains>^{BS}({PREFIX}{BS_})?{SUBPROG}{BS_} {
	// Fortran subroutine or function found		// Fortran subroutine or function found
	addSubprogram(yytext);		result= yytext;
			result= result.stripWhiteSpace();
			extractPrefix(result);
			addSubprogram(result);
	yy_push_state(Subprog);		yy_push_state(Subprog);
	}		}

	@@ -788,6 +794,7 @@ PREFIX (RECURSIVE{BS_}\|PURE{BS_}\|ELEMENTAL{BS_}){0,2}(RECURSIVE\|PURE\|ELEMENTA
	}		}
	<*>. {		<*>. {
	//debugStr+=yytext;		//debugStr+=yytext;
			//printf("I:%c\n", *yytext);
	} // ignore remaining text		} // ignore remaining text

	/**********************************************************************************/		/**********************************************************************************/
	@@ -796,12 +803,50 @@ PREFIX (RECURSIVE{BS_}\|PURE{BS_}\|ELEMENTAL{BS_}){0,2}(RECURSIVE\|PURE\|ELEMENTA
	%%		%%
	//----------------------------------------------------------------------------		//----------------------------------------------------------------------------

	static int getAmpersandAtTheEnd(const char *buf, int length)		static void extractPrefix(QCString &text) {
			int prefixIndex = 0;
			int curIndex = 0;
			bool cont = TRUE;
			const char* pre[] = {"RECURSIVE","PURE","ELEMENTAL"};
			while(cont)
			{
			cont = FALSE;
			for(unsigned int i=0; i<3; i++)
			{
			if((prefixIndex=text.find(pre[i], curIndex, FALSE))==0)
			{
			text.remove(0,strlen(pre[i]));
			text.stripWhiteSpace();
			cont = TRUE;
			}
			}
			}
			}

			static int getAmpersandAtTheStart(const char *buf, int length)
			{
			for(int i=0; i<length; i++) {
			switch(buf[i]) {
			case ' ':
			case '\t':
			break;
			case '&':
			return i;
			default:
			return -1;
			}
			}
			return -1;
			}

			/* Returns ampersand index, comment start index or -1 if neither exist.*/
			static int getAmpOrExclAtTheEnd(const char *buf, int length)
	{		{
	// Avoid ampersands in string and comments		// Avoid ampersands in string and comments
	int parseState = Start;		int parseState = Start;
	char quoteSymbol = 0;		char quoteSymbol = 0;
	int ampIndex = -1;		int ampIndex = -1;
			int commentIndex = -1;

	for(int i=0; i<length && parseState!=Comment; i++)		for(int i=0; i<length && parseState!=Comment; i++)
	{		{
	@@ -824,6 +869,7 @@ static int getAmpersandAtTheEnd(const char *buf, int length)
	break;		break;
	case '!':		case '!':
	parseState = Comment;		parseState = Comment;
			commentIndex = i;
	break;		break;
	case ' ': // ignore whitespace		case ' ': // ignore whitespace
	case '\t':		case '\t':
	@@ -837,7 +883,138 @@ static int getAmpersandAtTheEnd(const char *buf, int length)
	}		}
	}		}
	}		}

			if (ampIndex>=0)
	return ampIndex;		return ampIndex;
			else
			return commentIndex;
			}

			/* Although comments at the end of continuation line are grabbed by this function,
			* we still do not know how to use them later in parsing.
			*/
			void truncatePrepass(int index)
			{
			int length = inputStringPrepass.length();
			for (int i=index+1; i<length; i++) {
			if (inputStringPrepass[i]=='!') { // save comment
			//printf("-----SAVE----- %d:%s", i, (const char*)inputStringPrepass.right(length-i));
			struct CommentInPrepass *c=new CommentInPrepass(index, inputStringPrepass.right(length-i));
			comments.append(c);
			}
			}
			inputStringPrepass[index] = ' ';
			inputStringPrepass.truncate(index+1);
			}

			// simplified way to know if this is fixed form
			// duplicate in fortrancode.l
			static bool recognizeFixedForm(const char* contents)
			{
			int column=0;
			bool skipLine=FALSE;

			for(int i=0;;i++) {
			column++;

			switch(contents[i]) {
			case '\n':
			column=0;
			skipLine=FALSE;
			break;
			case ' ':
			break;
			case '\000':
			return FALSE;
			case 'C':
			case 'c':
			case '*':
			if(column==1) return TRUE;
			if(skipLine) break;
			return FALSE;
			case '!':
			if(column>1 && column<7) return FALSE;
			skipLine=TRUE;
			break;
			default:
			if(skipLine) break;
			if(column==7) return TRUE;
			return FALSE;
			}
			}
			return FALSE;
			}

			/* This function assumes that contents has at least size=length+1 */
			static void insertCharacter(char *contents, int length, int pos, char c)
			{
			// shift tail by one character
			for(int i=length; i>pos; i--)
			contents[i]=contents[i-1];
			// set the character
			contents[pos] = c;
			}

			/* change comments and bring line continuation character to previous line */
			static const char* prepassFixedForm(const char* contents)
			{
			int column=0;
			int prevLineLength=0;
			int prevLineAmpOrExclIndex=-1;
			bool emptyLabel=TRUE;
			int newContentsSize = strlen(contents)+2; // \000 and one spare character (to avoid reallocation)
			char* newContents = (char*)malloc(newContentsSize);

			for(int i=0, j=0;;i++,j++) {
			if(j>=newContentsSize-1) { // check for one spare character, which may be eventually used below (by &)
			newContents = (char*)realloc(newContents, newContentsSize+1000);
			newContentsSize = newContentsSize+1000;
			}

			column++;
			char c = contents[i];
			switch(c) {
			case '\n':
			prevLineLength=column;
			prevLineAmpOrExclIndex=getAmpOrExclAtTheEnd(&contents[i-prevLineLength+1], prevLineLength);
			column=0;
			emptyLabel=TRUE;
			newContents[j]=c;
			break;
			case ' ':
			newContents[j]=c;
			break;
			case '\000':
			newContents[j]='\000';
			return newContents;
			case 'C':
			case 'c':
			case '*':
			emptyLabel=FALSE;
			if(column==1)
			newContents[j]='!';
			else
			newContents[j]=c;
			break;
			default:
			if(column==6 && emptyLabel) { // continuation
			newContents[j]=' ';

			if(prevLineAmpOrExclIndex==-1) { // add & just before end of previous line
			insertCharacter(newContents, j+1, (j+1)-6-1, '&');
			j++;
			} else { // add & just before end of previous line comment
			insertCharacter(newContents, j+1, (j+1)-6-prevLineLength+prevLineAmpOrExclIndex, '&');
			j++;
			}
			} else {
			newContents[j]=c;
			emptyLabel=FALSE;
			}
			break;
			}
			}
			return newContents;
	}		}

	static void pushBuffer(QCString& buffer)		static void pushBuffer(QCString& buffer)
	@@ -850,11 +1027,12 @@ static void pushBuffer(QCString& buffer)
	include_stack[include_stack_ptr++] = YY_CURRENT_BUFFER;		include_stack[include_stack_ptr++] = YY_CURRENT_BUFFER;
	yy_switch_to_buffer(yy_scan_string(buffer));		yy_switch_to_buffer(yy_scan_string(buffer));

	//fprintf(stderr, "--POP--%s", (const char *)buffer);		//fprintf(stderr, "--PUSH--%s", (const char *)buffer);
	buffer = NULL;		buffer = NULL;
	}		}

	static void popBuffer() {		static void popBuffer() {
			//fprintf(stderr, "--POP--");
	include_stack_ptr --;		include_stack_ptr --;
	yy_delete_buffer( YY_CURRENT_BUFFER );		yy_delete_buffer( YY_CURRENT_BUFFER );
	yy_switch_to_buffer( include_stack[include_stack_ptr] );		yy_switch_to_buffer( include_stack[include_stack_ptr] );
	@@ -1454,6 +1632,19 @@ static void parseMain(const char fileName,const char fileBuf,Entry *rt)
	inputFile.setName(fileName);		inputFile.setName(fileName);
	if (inputFile.open(IO_ReadOnly))		if (inputFile.open(IO_ReadOnly))
	{		{
			isFixedForm = recognizeFixedForm(fileBuf);

			if (isFixedForm) {
			printf("Prepassing fixed form of %s\n", yyFileName.data());
			//printf("---strlen=%d\n", strlen(fileBuf));
			//clock_t start=clock();

			inputString = prepassFixedForm(fileBuf);

			//clock_t end=clock();
			//printf("CPU time used=%f\n", ((double) (end-start))/CLOCKS_PER_SEC);
			}

	yyLineNr= 1 ;		yyLineNr= 1 ;
	yyFileName = fileName;		yyFileName = fileName;
	msg("Parsing file %s...\n",yyFileName.data());		msg("Parsing file %s...\n",yyFileName.data());
	@@ -1484,6 +1675,10 @@ static void parseMain(const char fileName,const char fileBuf,Entry *rt)
	rt->program.resize(0);		rt->program.resize(0);
	delete current; current=0;		delete current; current=0;
	moduleProcedures.clear();		moduleProcedures.clear();
			if (isFixedForm) {
			free((char*)inputString);
			inputString=NULL;
			}

	inputFile.close();		inputFile.close();
	}		}

Admin message