/* ADIFFSQP version0.9(experimental) Released March, 1997 */
/* source code: adiffsqp.h */
/* Copyright (c) 1997 by Mingyan D. Liu and Andre L. Tits */
/* All Rights Reserved */

#define MAX_LINE_LEN 132          /* Max length of each FORTRAN line */
#define MAX_ID_LEN   132          /* Max length of each identifier   */
                                  /* for safety, must equal          */
				  /* MAX_LINE_LEN                    */
#define MAX_CARD_LEN 8192         /* Max length of a line of code    */
				  /* including continuations         */

#define COMMENT 0
#define LABEL   1
#define CONT    2
#define SUBR    3
#define DATA    4
#define EXEC    5
#define END     6
#define CALL    7

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

typedef struct {
   char Label[6], Cont, Code[67];
} Line;

typedef struct matchnode {
   char *fn_name, *gr_name;
   struct matchnode *next;
} MatchNode;


static long lineno = 0;





int getcard(inpf, dst)
char dst[];
FILE *inpf;
/* 
   This subroutine reads a card from the input file.  Comments are skipped
   over and continuations are processed.  One dummy call is required before
   data can be read.
*/
{
   static char lastln[MAX_CARD_LEN] = "      ",
               currln[MAX_LINE_LEN] = "";
   char got_card, *stat;

   got_card = 0;
   stat = fgets(currln, sizeof(currln), inpf);
   while (stat != NULL && got_card == 0) {
      lineno++;

      /*Read line and remove newline characters */
      if (currln[strlen(currln)-1] != '\n') {
         warning("Line exceeds buffer length.");
         /* Read till end of long line */
         do {
            stat = fgets(currln, sizeof(currln), inpf);
         } while (currln[strlen(currln)-1] != '\n');
      } else
         currln[strlen(currln)-1] = NULL;

      expand(currln);
      switch (classify(currln)) {
      case CONT:
         cardcat(lastln, currln+6);
      case COMMENT:
         stat = fgets(currln, sizeof(currln), inpf);
         break;
      default:
         got_card = 1;
      }
   } 

   cardcat(lastln, ""); /*remove unwanted spaces*/
   strcpy(dst, lastln);
   strcpy(lastln, currln);
   if (stat == NULL) 
      return(1);
   else
      return(0);
} 





int putcard(outf, card)
char card[];
FILE *outf;
/*
   This function breaks up a line of code and writes it to the specified
   file.
*/
{
   char *sp = card;
   char line[67];
   char label[7];

   strncpy(label, card, 6); /*copy label + continuation*/
   label[6] = NULL;
   fprintf(outf, "%s", label);
   sp += 6;                 /*now points to the start of code */
   
   do {
      if (strlen(sp) > 66) {
         strncpy(line, sp, 66);
         line[66] = NULL;
         fprintf(outf, "%s\n     *", line);
         sp+=66;
      } else {
         fprintf(outf, "%s\n", sp);
         sp = sp + strlen(sp);
      }
   } while (strlen(sp) != 0);
}




    
int classify(origcard)
char origcard[];
/* RETURN CODES: */
/*   0: Comment or blank
     1: label
     2: continuation
     3: fuction declaration
     4: subroutine declaration
     5: data declaration
     6: executable/directive
     7: end statement
     8: call statement

   This function determines the probable type of a card.
*/
{
   Line line;
   int i, func_flag;
   char dummy[MAX_CARD_LEN], *sp;
   char card[MAX_CARD_LEN];

   strcpy(card,origcard);
   strncpy(line.Label, card, 5);
   line.Label[5] = NULL;

   line.Cont = card[5];

   strncpy(line.Code, (card+6), 66);
   line.Code[66] = NULL;

   if (*line.Label == 'c'               ||
       *line.Label == 'C'               ||
       *line.Label == '*'               ||
       sscanf(card, "%s", dummy) == EOF)
      return(COMMENT);

   /*If there is a label, but nothing on a line */
   if (sscanf(line.Code, "%s", dummy) == EOF &&
       sscanf(line.Label, "%s", dummy) != EOF)
      return(LABEL);

   if (!isspace(line.Cont) &&
       line.Cont != '0')
      return(CONT);

   sscanf(line.Code, "%s", dummy);
   if (strstr(dummy, "subroutine") == dummy)
      return(SUBR);

   if (strstr(dummy, "call") == dummy) 
      return(CALL);

   /*Check if there is a data declaration */
   if (strstr(dummy, "real")      == dummy ||
       strstr(dummy, "integer")   == dummy ||
       strstr(dummy, "double")    == dummy ||
       strstr(dummy, "logical")   == dummy ||
       strstr(dummy, "external")  == dummy ||
       strstr(dummy, "data")      == dummy ||
       strstr(dummy, "parameter") == dummy ||
       strstr(dummy, "common")    == dummy ||
       strstr(dummy, "character") == dummy )
      return(DATA);

   /*END on a line by itself */
   if (strcmp(dummy, "end") == 0                                &&
       sscanf(strstr(line.Code, "end") + 3, "%s", dummy) == EOF)
      return(END);

   /*If all else fails, this is probably an executable*/
   return(EXEC);
}





char *getparmname(origcard, n)
int n;
char origcard[];
/* This subroutine returns the nth parameter from a statement.
*/
{
   int counte = 0, countb = 0;
   char quote;
   int nparen = 0;
   char *sp1, *sp2, *sp3;
   static char res[MAX_LINE_LEN];
   char card[MAX_CARD_LEN];

   strcpy(card,origcard);
  
   sp1 = card;
   while (*sp1 != NULL && counte != n) {
      /* Skip over quotation marks */
      if ( *sp1 == '\'' || *sp1 == '"') {
         quote = *sp1;
         do
            sp1++;
         while (*sp1 != quote && *sp1 != NULL);
         if (*sp1 != NULL) sp1++;
      } else {
         if ( *sp1 == '(')
            nparen++;
         else if ( *sp1 == ')')
            nparen--;
         if ((*sp1 == ',' || *sp1 == '(') && nparen == 1) {
            countb++;
            if (countb == n)
               sp2 = sp1;
         }
         if ((*sp1 == ',' && nparen == 1) ||
             (*sp1 == ')' && nparen == 0)) {
            counte++;
            if (counte == n)
               sp3 = sp1;
         }
         sp1++;
      }
   }

   strncpy(res, sp2+1, sp3-sp2-1);
   res[sp3-sp2-1] = NULL;
   return(res);
}





void classifytypedata(origcard, nameparms, typeparms, x)
int x;
char nameparms[][MAX_ID_LEN], typeparms[];
char origcard[];
/*
   This subroutine assigns types to corresponding parameter names if one
   is not already assigned.
   INTEGER = I
   DOUBLE  = D
   EXTERNAL = E
   OTHER = X
*/
{
   int i;
   char *sp1, *sp2;
   char card[MAX_CARD_LEN],test[20];

   strcpy(card,origcard);

   if ((sp2 = strstr(card, "integer")) != NULL) 
      sp2+=7; /*length of substring*/
   else if ((sp2 = strstr(card, "external")) != NULL)
      sp2+=8;
   else if ((sp2 = strstr(card, "double precision")) != NULL)
      sp2+=16;
   else if ((sp2 = strstr(card, "doubleprecision")) != NULL)
      sp2+=15;
   else if ((sp2 = strstr(card, "double")) != NULL)
      sp2+=6;

   for (i=0;i<x;i++) 
   {  
      if (islower(typeparms[i]) || /*lower case is tentative*/
          typeparms[i] == ' ') 
      if (  (sp1=strstr(card,nameparms[i])) != NULL
            /*  &&  signal==1   */ )                 /*nth param. present? */
            if ((!isalnum(*(sp1-1)) || sp1 == sp2) &&
	        !isalnum(*(sp1+strlen(nameparms[i])))){
               if (strstr(card,"integer") == card)
                  typeparms[i] = 'i';
               else if (strstr(card,"double") == card)
                  typeparms[i] = 'd';
               else if (strstr(card,"external") == card)
                  typeparms[i] = 'e';
               else
                  typeparms[i] = 'x';
             }
     }
   return;
}





int rm_argument(origcard,card)
char origcard[],card[];
{
   int i,j,signal;
   j=0;
   signal=0;

   for (i=0;i<=strlen(origcard);i++)
   {
     if ( signal==0 && origcard[i]!='(' )
       card[j++]=origcard[i];
     else if (origcard[i]=='(')
       signal+=1;
    
     if ( signal!=0 && origcard[i]==')' )
       signal-=1;
   }
   return(0);
 }





char *getsubname(origcard)
char origcard[];
/*
   This subroutine returns the subrourine name from a subroutine declaration
   card.
*/
{
   char card[MAX_CARD_LEN];
   char *sp1, *sp2;

   strcpy(card,origcard);

   sp1 = strstr(card, "subroutine") + 10 /*length*/;
   while (isspace(*sp1)) sp1++;
   sp2 = sp1;
   while (isalnum(*sp2) || ((*sp2)=='_') ) sp2++;
   *sp2 = NULL;

   return(sp1);
}





char *getcalledfnname(origcard)
char origcard[];
/* This subroutine returns the subrourine name from a subroutine call
   card.
*/
{
   char card[MAX_CARD_LEN];
   char *sp1, *sp2;

   strcpy(card,origcard);

   sp1 = strstr(card, "call") + 4 /*length*/;
   while (isspace(*sp1)) sp1++;
   sp2 = sp1;
   while (isalnum(*sp2)) sp2++;
   *sp2 = NULL;

   return(sp1);
}





int numparms(origcard)
char origcard[];
/* This function counts the number of arguments in a statement.
*/
{
   int count = 0;
   char quote;
   int nparen = 0;
   char *sp1;

   sp1 = origcard;
   while (*sp1 != NULL) {
      /* Skip over quotation marks */
      if ( *sp1 == '\'' || *sp1 == '"') {
         quote = *sp1;
         do
            sp1++;
         while (*sp1 != quote && *sp1 != NULL);
         if (*sp1 != NULL) sp1++;
      } else {
         if ( *sp1 == '(')
            nparen++;
         else if ( *sp1 == ')')
            nparen--;
         if ((*sp1 == ',' && nparen == 1) ||
             (*sp1 == ')' && nparen == 0))
            count++;
         sp1++;
      }
   }

   return(count);
}





int expand(card)
char card[];
/*
  This subroutine expands tabs to spaces.  The returned card is padded 
  with spaces to 72 characters.  Any extra characters are ignored.
*/
{
   int i,x;
   char tmp[73]; /*72 + 1 for NULL*/

   x = 0;
   for (i=0; i<strlen(card) && x<72; i++) {
      if (card[i] == '\t') 
         do 
            tmp[x++] = ' ';
         while (((x % 8) != 0) && (x<72));
      else 
         tmp[x++] = card[i];
   }

   /*pad string with spaces and terminate with a NULL*/
   for (i=x; i<72; i++) tmp[i] = ' ';
   tmp[72] = NULL;
   strcpy(card, tmp);
   return (0);
}





int cardcat(orig, new)
char orig[], new[];
/*
   This subroutine removes unwanted spaces from a card and concatenates
   the two cards together.  The new card must not contain the label. 
*/
{
   char symbol;
   int quotes = 0, x = 6, i;
   char tmp[MAX_CARD_LEN+MAX_LINE_LEN];

   strncpy(tmp, orig, 7);
   strcat(orig, new);
   for (i=6; i<strlen(orig); i++) 
      if (orig[i] == '"' ||
          orig[i] == '\'' ) {
         if (quotes == 0) {
            symbol = orig[i];
            quotes = 1;
         } else if (symbol == orig[i]) 
            quotes = 0;
         tmp[x++] = orig[i];
      } else if (quotes == 1) 
         tmp[x++] = orig[i];
      else if (!isalnum(orig[i]) && isspace(tmp[x-1]) && x>6) 
            tmp[x-1]=orig[i];
      else if (isspace(orig[i]) && !isalnum(tmp[x-1]))
            {/*do nothing */ x = x;}
      else
         tmp[x++] = orig[i];
   
   tmp[x] = NULL;
   if (isspace(tmp[x-1]) && x>6) tmp[x-1] = NULL;

   strcpy(orig, tmp);
   return(0);
}





int error(msg)
char msg[];
/*
   This procedure sends an error message to stderr (without a line number).
*/
{
   fprintf(stderr, "adiffsqp: %s\n", msg);
   return 0;
}

int errorl(msg)
char msg[];
/*
   This procedure sends an error message to stderr.
*/
{
   fprintf(stderr, "adiffsqp: Error on line %ld: %s\n", lineno, msg);
   return 0;
}

int warning(msg)
char msg[];
/*
   This procedure sends a warning message to stderr.
*/
{
   fprintf(stderr, "adiffsqp: Warning on line %ld: %s\n", lineno, msg);
   return 0;
}





MatchNode *initmatchtable()
{
   return ((MatchNode *)NULL);
}




MatchNode *newmatchnode(root)
MatchNode *root;
/*
   This function allocates a new table entry using a linked list.  The
   updated root pointer is returned.
*/
{
   MatchNode *newnode;

   newnode = (MatchNode *)malloc(sizeof(MatchNode));
   newnode->next = root;
   return (newnode);
}





MatchNode *addfntonode(root, fn_name)
char fn_name[];
MatchNode *root;
/* This function adds a function name to a Match table node */
{
   root->fn_name = (char *)malloc(strlen(fn_name) + 1);
   strcpy(root->fn_name, fn_name);
   return(root);
}

MatchNode *addgrtonode(root, gr_name)
char gr_name[];
MatchNode *root;
/* This function adds a gradient name to a Match Table node */
{
   root->gr_name = (char *)malloc(strlen(gr_name) + 1);
   strcpy(root->gr_name, gr_name);
   return(root);
}





MatchNode *findfnname(root, fn_name)
MatchNode *root;
char fn_name[];
/*
   This function returns the pointer to a node that contains fn_name.
   If a node is not found, NULL is returned.
*/
{
   MatchNode *tmp = root;
   int found = 0;

   while (tmp != (MatchNode *)NULL && found == 0) {
      if (strcmp(tmp->fn_name, fn_name) == 0) 
         found = 1;
      else
         tmp = tmp->next;
   }

   return(tmp);
}






MatchNode *findgrname(root, gr_name)
MatchNode *root;
char gr_name[];
/*
   This function returns the pointer to a node that contains gr_name.
   If a node is not found, NULL is returned.
*/
{
   MatchNode *tmp = root;
   int found = 0;

   while (tmp != (MatchNode *)NULL && found == 0) {
      if (strcmp(tmp->gr_name, gr_name) == 0) 
         found = 1;
      else
         tmp = tmp->next;
   }

   return(tmp);
}





void delallnodes(root)
MatchNode *root;
/* This function erases a List starting from the specified node.  All
   string memory is deallocated also.
*/
{
   MatchNode *tmp = root, *old;
  
   while (tmp != (MatchNode *)NULL) {
      free(tmp->fn_name);
      free(tmp->gr_name);
      old = tmp;
      tmp = tmp->next;
      free(old);
   }
}

/* ADIFFSQP version0.9(experimental) Released March, 1997 */
/* source code: adiffsqp.h */
/* Copyright (c) 1997 by Mingyan D. Liu and Andre L. Tits */
/* All Rights Reserved */
/*********************LAST LINE IN FILE*******************************/