[Prev][Next][Index]

Include anf fortran


f2dep expands include file in a fortran source file. But when
you want to unparse the file .dep into a file .f, you
don't have the inverse operation.

So the solution proposed by F. Bodin and me for f2dep is
the following :

Now, we indicate in the dep file, the source name of each
statement. We manage the imbricate include by a stack.

-------------------------------------------------------
*** lex.c line 521,637  /****** MODIF *******/
***************

/****** MODIF *********/
typedef struct stack_name {
           struct stack_name *next;
     PTR_FNAME saveName;
   } stack_name ;
 
static stack_name *stackNameFile = NULL, *aElt;

void
doinclude(name)
  char   *name;   /* file name string of the INCLUDE file to be
         * set up */
{
  FILE   *fp;
  struct Inclfile *t;
  char    temp[100];
  register char *lastslash, *s;
  register char *p, *q;

  /****** MODIF **********/ 
  if (stackNameFile == NULL) {
    stackNameFile = (stack_name *) calloc (1, sizeof (stackNameFile));
    stackNameFile->saveName = cur_thread_file;
    stackNameFile->next     = NULL;
  }
  else {
    aElt = (stack_name *) calloc (1, sizeof (stackNameFile));
    aElt->saveName = cur_thread_file;
    aElt->next     = stackNameFile;
    stackNameFile  = aElt;
  }
 
  make_file_list(name);
  if (inclp) {
    --lines_returned;
    inclp->incllno = thislin;
    inclp->inclcode = code;
    if(nextcd)
      inclp->incllinp = copyn(inclp->incllen = endcd-nextcd , nextcd);
    else
      inclp->incllinp = 0;
  }
  nextcd = (char *)NULL;
 
  if(++nincl >= MAXINCLUDES)
    fatal("includes nested too deep\n");
  if (name[0] == '\0')
    fp = stdin;
  else
    fp = fopen(name, "r");
  if (fp)
        {
    t = inclp;
    inclp = (struct Inclfile *) chkalloc(sizeof(struct Inclfile));
    inclp->inclnext = t;
    prevlin = thislin = 0;
    inclp->inclname = name;
    infname = copys(name);
    infile = inclp->inclfp = fp;
  } else
     fatalstr("Cannot open file %s\n", name);
}
 
 
/*
 * This routine eliminates the current INCLUDE file block and sets up the
 * immediately previous INCLUDE file block as the current block.
 *
 *  return value = YES (1) if we are at INCLUDE level >= 2
 *           NO  (0) if we are at the top level (we hit end-of-file)
 */
int
popinclude()
{
  struct Inclfile *t;
  register char *p;
  register int k;
  void clf();
 
  /****** MODIF *******/
  if (stackNameFile->saveName &&  cur_thread_file) {
    cur_thread_file = stackNameFile->saveName;
    aElt = stackNameFile;
    stackNameFile = stackNameFile->next;
    free (aElt);
  }
 
/* Free the space for this include file's buffer. */
 
  if (infile != stdin)
    clf(&infile);
  free(infname);
 
  --nincl;
  t = inclp->inclnext;
  free((char *)inclp->inclname);
  free((char *) inclp);
  inclp = t;
  if (!inclp)
    return (NO);
 
  infile = inclp->inclfp;
  infname = copys(inclp->inclname);
  prevlin = thislin = inclp->incllno;
  code = inclp->inclcode;
  stno = nxtstno = inclp->inclstno;
  if (inclp->incllinp) {
    endcd = nextcd = stmtbuf;
    k = inclp->incllen;
    p = inclp->incllinp;
    while (--k >= 0)
      *endcd++ = *p++;
    free((char *) (inclp->incllinp));
  } else
    nextcd = (char *)NULL;
  return (YES);
}

-------------------------------------------------------

When we uses Sage++ librairies, we can compare the name 
of the source file with the name of each statement to know where code from
include files are located. 
A example of the subroutine to delete the source code
 expanded by f2dep is the following :
Remark :
- I uses comment to make a include declaration, maybe
an another method is possible.
- doesn't work for imbricate include.

-------------------------------------------------------
void deleteCodeExpanded (SgStatement *firstStmt, char *name)
{
  SgStatement *stmt, *old, *aInclude;
  int id, isBuffer;
  char    buffer[1000];
  stmt = firstStmt;
   isBuffer = 0;
   buffer   = 0;
   while(stmt) {
    if (stmt->thebif->filename) {
      if (strcmp (name, stmt->thebif->filename->name) ) {
	id = stmt->thebif->filename->id;
	while (id == stmt->lexNext()->thebif->filename->id) {	  
	  old  = stmt;
	  stmt = stmt->lexNext();
	  old->deleteStmt ();
	}
	strcat (buffer, "      include '");
	strcat (buffer, stmt->thebif->filename->name);
	strcat (buffer, "'\n");
	isBuffer = 1;
	old  = stmt;
	stmt = stmt->lexNext();
	old->deleteStmt ();
      }
      else { 
	if (isBuffer) {
	  stmt->addComment (buffer);
	  isBuffer = 0;
	  buffer = 0;
	}
	stmt = stmt->lexNext();
      }
    }
    else 
      stmt = stmt->lexNext();
  }
}
-------------------------------------------------------


 
 



S. Yhuel

+---------------------------------------------------------------------+
Stephane YHUEL (Scientifique du contingent)   
ONERA DI          Calcul Parallele   "E-mail" : yhuel@onera.fr   
29,  Avenue de la Division Leclerc   Telecopie: +33 (1) 46 73 43 83 
BP 72 92322 Chatillon Cedex FRANCE   Telephone: +33 (1) 46 73 40 40 
+---------------------------------------------------------------------+