/*************************************************************************/
/*                                                                       */
/*      flow.c - A program to analyse Fortran77 programs                 */
/*                                                                       */
/* --------------------------------------------------------------------- */
/*  Copyright (c) 1996 by Dirk Geschke, <geschke@physik.uni-kassel.de>   */
/*************************************************************************/
/*  This program is free software; you can redistribute it and/or modify */
/*  it under the terms of the GNU General Public License as published by */
/*  the Free Software Foundation; either version 2 of the License, or    */
/*  (at your option) any later version.                                  */
/*                                                                       */
/*  This program is distributed in the hope that it will be useful,      */
/*  but WITHOUT ANY WARRANTY; without even the implied warranty of       */
/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        */
/*  GNU General Public License for more details.                         */
/*                                                                       */
/*  You should have received a copy of the GNU General Public License    */
/*  along with this program; if not, write to the Free Software          */
/*  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.            */
/*************************************************************************/

#include <stdlib.h>
#include <stdio.h>
#include <ctype.h>
#include <string.h>

#define VERSION 0.12
#define NO_SUB  1000
#define NO_PROG 1      
#define NO_CALL 5000

/* declaration of functions */

void RoutineCheck(char *Line);
void Upcase(char *Line);
void Routine_name(char *Line,char *R_Name);
void help(char *PROG);
void Output_Result();
void SUB_find(char *Name);

/* new type declaration*/

struct Fort_Element 
{
  char Name [60];
  int  Call;
};

/*      G L O B A L  variables */

struct Fort_Element Subroutine[NO_SUB+1];    /* storages subroutine names */
struct Fort_Element Program;                /* storages program name     */  
struct Fort_Element Call[NO_CALL];         /* storages CALL names       */

int s_call=0;    /* counts CALL statements */
int subrout=0;   /* counts SUBROUTINE statements */
int if_count=0;  /* counts IF statements  */
long int Comment=0; /* counts COMMENT lines */

int Prog_Anf=-1; /* storages number of first CALL of SUBROUTINE from PROGRAM */
int Prog_Ende=0; /* storages number of last CALL of SUBROUTINE from PROGRAM */

int Level=1;
long int ActLine=0;
char Dat_Name [81]; /* name of actual file */

FILE *CallFile=NULL;
FILE *SubFile=NULL;
FILE *OUTFILE=NULL;

char S_OUT[]="FLOW.SUBS"; /* file name where to print subroutines */
char C_OUT[]="FLOW.CALL"; /* file name where to print call's */

int No_Main=0;


/* Optionkeys */

int O_SUBROUTINE=0;
int O_CALL=0;
int O_InFile=0;
int O_FIND=0;
int O_FICALL=0;
int O_FISUB=0;
int O_OutFile=0;
int O_RECURS=0;
int O_WARN72=0;
int O_NEWSTART=0;

/* begin of main */

int main(int argc, char *argv[]) 

{
int k,d,i;
char Line [81];
char firstChar;
char Option;
FILE *InFile=NULL;
long int Count_Lines=0;
char PRG_Name[60];

OUTFILE=stdout;

for (k=0; k<NO_SUB+1; k++) Subroutine[k].Call=0;
for (k=0; k<NO_CALL; k++) Call[k].Call=0;
   Program.Call=0;

strcpy(PRG_Name,*argv);

   if (argc==1) help(PRG_Name);

for (d=1; d<argc; d++)
  {

   argv++;
   strcpy(Dat_Name,*argv);

   if (Dat_Name[0] =='-' ) 
   {    
    for(k=1; k<strlen(Dat_Name); k++)
       {
	 Option=Dat_Name[k];

	 switch(Option)
	  {

	  case 'R' : O_RECURS=1;
                     break;

	  case 'S' : O_SUBROUTINE=1;
                     break;
       
     	  case 's' : if (O_FISUB==0) /* skip step if repeated option */
	             {
		       if ((SubFile=fopen(S_OUT,"w")) == NULL)
		        { 
		     	fprintf(stderr,"\nError: Can't open file %s!\n\n",
                                S_OUT);
				exit(2); 
			}}
	             O_FISUB=1;
		     break;

     	  case 'c' : if (O_FICALL==0 ) /* skip step if repeated option */
	             {
	               if ((CallFile=fopen(C_OUT,"w")) == NULL)
			 { 
			   fprintf(stderr,"\nError: Can't open file %s!\n\n",
                                   C_OUT);
			   exit(2); 
			 }}
	             O_FICALL=1;
		     break;

	  case 'C' : O_CALL=1;
	             break;

	  case 'f' : O_OutFile=1;
                     break;

	  case 'F' : O_InFile=1;
                     break;

          case 'h' : help(PRG_Name);
                     break;

          case 'r' : if (k+1 == strlen(Dat_Name)) 
                       { 
                         if (d < argc)
                         {
                           argv++; d++; /* Counter one step further */

                           /* New starting point */
                           strcpy(Subroutine[0].Name,*argv); 
                           Upcase(Subroutine[0].Name);
                           printf("\nChanged starting point to SUBROUTINE %s\n",\
                                    Subroutine[0].Name);
                          }
                       }
                      if (strlen(Subroutine[0].Name) == 0)
                        {
                      /* An Error occured */
                      printf("\nError with option -r");
                      printf("\nMissing Name for starting SUBROUTINE");
                      exit(2);
                        }

                     O_NEWSTART=1;
                     break;

	  case 'U' : O_FIND=1;
                     break;

          case 'V' : printf("\n\n%s Version %1.2f\n",PRG_Name,VERSION);
                     printf("Author: Dirk Geschke\n\n");
                     exit(2);
		      
	  case 'W' : O_WARN72=1;
	             break;

	  default: fprintf(stderr,"\n\nunallowed option: -%c \n",Option);
	           help(PRG_Name);
	    /* exit(2); */
	  }
     }
   continue;
   }


   if ((InFile=fopen(Dat_Name,"r")) == NULL) 
     { 
       fprintf(stderr,"\nError: Can't open file %s!\n\n",Dat_Name);
       exit(2); 
     }
 
   ActLine=0; /* counts lines in actual file */

   if (O_InFile) printf("\n Actual file: %s \n",Dat_Name);


   while (fgets(Line,81,InFile) != NULL)
     {
       ActLine++;
       Count_Lines++;
       Upcase(Line);
       firstChar = Line[0];
       if ((firstChar == 'C') || (firstChar=='*') || (strlen(Line)<2)) 
	 Comment++;
       else 
	 {
	   if (O_WARN72) /* Control the length of the actual line */
	     {
	       i=strlen(Line);
	       if (i>73)
		 {
		   while (Line[i-2]==32) i--; 
		   /* only empty spaces at the end?  */
                   /* -1 for EOL sign and -1 because */
		   /* of beginning at Line[0] => i-2 */
		   
		   if (i>73) 
		   fprintf(stderr,"Warning: Line %ld in file %s \
consists of %d characters!\n",ActLine,Dat_Name,i-1);
		 }
	     }
	   
	   RoutineCheck(&Line[6]);
	 }
     }

   /* if there is no definition of a SUBROUTINE in the same file 
      after the PROGRAM routine, use EOF as end of PROGRAM statement   */

      if (Program.Call==1)
        {
          Program.Call=0; Prog_Ende=s_call-1;
        }

      fclose(InFile);
}

if (O_FISUB)  fclose(SubFile);
if (O_FICALL) fclose(CallFile);


if (InFile==NULL) help(PRG_Name);

   if (strlen(Program.Name)==0)
     {
      fprintf(stderr,"\n\nError: No starting point found!\n\n");
      No_Main=1;
     }

   if (O_OutFile)
     {
       strcpy(Dat_Name,Program.Name);
       strcat(Dat_Name,".FLOW");
       if ((OUTFILE=fopen(Dat_Name,"w")) == NULL) 
	 { 
	   fprintf(stderr,"\nError: Can't open file %s!\n\n",Dat_Name);
	   exit(2); 
	 }
     }

   if (O_NEWSTART==1) /* new starting point */
     {
       fprintf(OUTFILE,"\n\n Results of subroutine %s:\n",Program.Name);
       fprintf(OUTFILE," =======================");
     }
   else
     {
   fprintf(OUTFILE,"\n\n Results of program %s:\n",Program.Name);
   fprintf(OUTFILE," ====================");
     }
   for (k=0; k<strlen(Program.Name); k++) fprintf(OUTFILE,"=");
   fprintf(OUTFILE,"\n\n ");
   fprintf(OUTFILE,"Total number of lines : %7ld \n ", Count_Lines);
   fprintf(OUTFILE,"Comment lines         : %7ld \n ", Comment);
   fprintf(OUTFILE,"Code lines            : %7ld \n ", Count_Lines-Comment);
   fprintf(OUTFILE,"IF statements         : %7d \n ", if_count);
   fprintf(OUTFILE,"SUBROUTINE statements : %7d \n ", subrout);
   fprintf(OUTFILE,"CALL statements       : %7d \n\n", s_call);

   if (No_Main==0) Output_Result();

   if (O_OutFile) fclose(OUTFILE);

   exit(0);
 
}

/*         END of main            */


/***************************************************************
 *                                                             *
 *  This function converts line to uppercase character         *
 *                                                             *
 ***************************************************************/

void Upcase(char *Line)   

{
   char *w=Line;

   while (*w !='\0' )
   *w++=toupper(*w);  /* chance each character TO UPPER char's */

}



/*****************************************************************
 *                                                               *
 *   Checks for  SUBROUTINE, PROGRAM, CALL.                      *
 *   Counting of CALLS and declaration of procedures             *
 *                                                               *
 ****************************************************************/

void RoutineCheck(char *Line)

{
   int i=0;
   int j=0;
   int Klammer_auf=0;
   static int p=0;
   char Sign [11];
   char *ptr;
   char *ROUTINE="SUBROUTINE ";
   char *CALL="CALL ";
   char *PROG="PROGRAM ";
   char *THEN="THEN";
 
   while (Line[i]==32) i++;     /* removing of leading spaces */
   ptr=&Line[i];
   if (strlen(ptr)<2)
     {
       Comment++;       /* empty line = comment */
       return;
     }

   /* Test for SUBROUTINE */

   strncpy(Sign,ptr,11);   /* copying first 10 character of string */
   Sign[11]='\0';          /* ptr in sign1. */

   if (strcmp(ROUTINE,Sign)==0)  /* compares two strings */
     { 
       if (Program.Call!=0)
	 {
	   Program.Call=0;
	   Prog_Ende=s_call-1;
	 }
       subrout++;
       if (subrout==NO_SUB)
	 {
	   fprintf(stderr,"Too many SUBPROCESS statements!\n");
           fprintf(stderr,"Increase parameter NO_SUB!\n");
	   exit(2);
	 }

       /* removing of leading space and extracting the */
       /* name of SUBROUTINE out of line */

       strcpy(Line,&Line[i+11]); 

       /* finding name of subroutine */

       Routine_name(Line,Subroutine[subrout].Name);

       /* Check if the Subroutine is the starting point of the actual run */
       
       if ((O_NEWSTART==1) && (strcmp(Subroutine[0].Name,Subroutine[subrout].Name)==0))
         {
           p++;
           if (p>1)
             {
               fprintf(stderr,"\n\aToo many definitions of SUBROUTINE %s!\n",\
                       Subroutine[0].Name); 
               exit(2);
             }
           Program.Call=1;
           strcpy(Program.Name,Subroutine[0].Name); /* starting point found */ 
         }
       else
         {
       if (O_SUBROUTINE) 
	 printf("           %s \n",Subroutine[subrout].Name); 
      
       if (O_FISUB)
         fprintf(SubFile,"%-20s %-20s line %6ld\n",
		 Subroutine[subrout].Name,Dat_Name,ActLine);
         }
       return;
     }

   /* PROGRAM? If starting point is a Subroutine skip this step */

   if (O_NEWSTART==0)
   {
     strncpy(Sign,ptr,8);
     Sign[8]='\0';   
     if (strcmp(PROG,Sign)==0)
       {
         p++;
         strcpy(Line,&Line[i+8]);
         if (p>1)
           {
             fprintf(stderr,"\n\aToo many definitions of PROGRAM!\n"); 
             exit(2);
           }
         Routine_name(Line,Program.Name);
         strcpy(Subroutine[0].Name,Program.Name);
         Program.Call=1;
         return;
       }
   }

   /* IF line? If true then find out if there is a CALL in it. */

   if ((Line[i]=='I')&& (Line[i+1]=='F'))
     if ((Line[i+2]==' ')||(Line[i+2]=='(')) /* IF line found */
       {
	 if_count++;
	 for (j=i+2; j<strlen(Line); j++)
	   {
	     if (Line[j]=='(') Klammer_auf++;
	     if ((Line[j]==')') && (Klammer_auf))
	       {

	       /* one bounded pair of parenthesis */

		 Klammer_auf--;

		 if (Klammer_auf==0) /* outer parenthesis balanced */ 
		   {
		     j++;
		     ptr=&Line[j];
		     break;           /* 'IF (...)' removed  */
		   }
	       }
	   } /* END for j */
       }

	if (j>0) /* IF line */ 
	  {
            i=j;
	    ptr=&Line[i];
	    
	    while (Line[i]==32) i++;  /* removing leading spaces! */ 
	    ptr=&Line[i];

	    /* Check for 'IF (...) THEN' structure */

	    strncpy(Sign,ptr,4);
            if(strcmp(THEN,Sign)==0)
	      {
               i+=4;
	       while (Line[i]==32) i++;  /* removing leading spaces! */ 
	       ptr=&Line[i];
	      }
	  }
       
	/* Check for CALL statement */

   strncpy(Sign,ptr,5);
   Sign[5]='\0';                  /* append end-of-string sign */
   if (strcmp(CALL,Sign)==0)
     {
       s_call++;

       if (s_call==NO_CALL)
	 {
	   fprintf(stderr,"Too many CALL statements\n");
           fprintf(stderr,"Increase parameter NO_CALL!\n");
	   exit(2);
	 }

       strcpy(Line,&Line[i+5]);
       Routine_name(Line,Call[s_call-1].Name);
       Call[s_call-1].Call=subrout;

       if (Program.Call==1)      
	 {
           if (Call[s_call-1].Call==subrout) /* 1. Call from Program */
	     {
	       if (Prog_Anf==-1) 
		 {
		   Prog_Anf=s_call-1;
		   if (s_call==0) Prog_Anf=s_call;
		   Call[s_call-1].Call=0;
		 }
	     }
	 }

       if (O_CALL) printf("CALL %s \n",Call[s_call-1].Name);

       if (O_FISUB)
         fprintf(CallFile,"%-20s %-20s line %6ld\n",Call[s_call-1].Name,
		 Dat_Name,ActLine);
     }
}




/**************************************************************
*                                                             *
*     This function is used to extract the name of called     *
*     or defined procedure.                                   *
*                                                             *
**************************************************************/

void Routine_name(char *Line, char *R_Name)

{
  int i=0;
  int offset=0;

  /* removing of leading spaces */

  while (Line[offset]==32) offset++;
 
  /* space, opened parenthese or EOL are a sign for end of routine name */ 

  while ((Line[i+offset] !=' ' ) && (Line[i+offset] != '(' ) 
	 && (Line[i+offset] !='\n'))
     {
       R_Name[i]= Line[i+offset];
       i++;
     }   
   
  R_Name[i]='\0';                /* append end of string! */
}




/********************************************************************
*                                                                   *
*             Printing if error with input or option -h             *
*                                                                   *
********************************************************************/


void help(char *PROG)

     {
      printf("\n\nUsage: %s [-hCcFSsV] file [files... ] \n\n",PROG);
      printf("  -h: Printing of this message \n");
      printf("  -C: Printing of each found CALL during the input\n");
      printf("  -c: Each found CALL statement is reported \n");
      printf("      in a file named %s with the name of the\n", C_OUT);
      printf("      file where it was found and the line number\n");
      printf("  -F: Print name of file actually on work \n");
      printf("  -f: The output is written to a file with the name \n");
      printf("      of the <program>.FLOW\n");
      printf("  -U: Printing of unknown SUBROUTINE calls\n");
      printf("  -r <name>: Set a new starting point. Start with the \n");
      printf("             SUBROUTINE <name> instead of PROGRAM line\n");
      printf("  -R: Omit following recursive calls\n");
      printf("  -S: Printing of each found SUBROUTINE during the input\n");
      printf("  -s: Each found SUBROUTINE is reported in a file \n");
      printf("      named %s with the name of the\n", S_OUT);
      printf("      file where it was found and the line number\n");
      printf("  -V: Number of version\n");
      printf("  -W: A warning is given if a code line exceeds the\n");
      printf("      length of 72 characters\n");
      printf("\nFor further information see manual page flow(1).\n\n");
      exit(2);
     }



/********************************************************************
*                                                                   *
*     Printing of SUBROUTINE calls out of main PROGRAM              *
*                                                                   *
********************************************************************/


void Output_Result()
{
int i,k;

for (i=Prog_Anf; i<Prog_Ende+1; i++)
  {
        fprintf(OUTFILE,"%s \n",Call[i].Name);   /* Level 0 call */
        for (k=1; k<subrout+2; k++) Subroutine[k].Call=0;
	Level=0;
	SUB_find(Call[i].Name);
  }
}



/*********************************************************************
*                                                                    *
*        Printing the name of the called SUBROUTINE and maybe        *
*        finding the called SUBROUTINE in the input and write        *
*        a warning if not found.                                     *
*********************************************************************/

void SUB_find(char *Name)

{
int i,j,k;
int found=0;

for (i=1; i<subrout+2; i++)            /* i=0 : PROGRAM statement! */
  {
    if (strcmp(Name,Subroutine[i].Name)==0)
      {
        found=1;                      /* definition of SUBROUTINE found */
        for (j=0; j<s_call; j++)
	  {
	    if (Call[j].Call==i) 
	      {
                /*		if (Subroutine[i].Call != Level)*/
		  {
		    Subroutine[i].Call=Level;
                   
		    if (O_RECURS ) Call[j].Call=0;/* omit recursive hanging */

                    Level++;

                    /* printing subroutine call */

                    for (k=0; k<Level; k++) fprintf(OUTFILE,"     ");
                    fprintf(OUTFILE,"%s\n",Call[j].Name);

                    /* Further CALL from called subroutine? */

		    SUB_find(Call[j].Name); 

                    Level--; /* reduce Level by one step */
		  }
	      }
	  }/* END for j */
      }
  }


/* Is the called SUBROUTINE declared in any input file? */

if ((found==0) && (O_FIND))  
  {
    fprintf(stderr,"\n WARNING: Subroutine %s not found! \n",Name);
  }
}