source_file.c File Reference

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <dirent.h>
#include <sys/stat.h>
#include <ctype.h>
#include <unistd.h>
#include <errno.h>
#include "genC.h"
#include "linear.h"
#include "ri.h"
#include "database.h"
#include "misc.h"
#include "properties.h"
#include "ri-util.h"
#include "pipsdbm.h"
#include "constants.h"
#include "resources.h"
#include "phases.h"
#include "property.h"
#include "preprocessor.h"
#include <regex.h>

Include dependency graph for source_file.c:

Go to the source code of this file.

Macros
#define	skip_line_p(s)    ((*(s))=='\0' || (*(s))=='!' || (*(s))=='*' || (*(s))=='c' || (*(s))=='C')
	include "pipsmake.h" More...
#define	IMPLICIT_NONE_RX   "^[ \t]*implicit[ \t]*none"
#define	INCLUDE_FILE_RX   "^[ \t]*include[ \t]*['\"]\\‍([^'\"]*\\‍)['\"]"
#define	CMPLX_RX   "^[^\t!*Cc].....[^\"']*[^a-zA-Z0-9_ \t][ \t]*\\‍((\\‍)[-+0-9eE\\. \t]*,[-+0-9eE\\. \t]*)"
	not recognized: print *, "i = ", (0.,1.) to avoid modifying a character constant... More...
#define	CMPLX2_RX   "^[^\t!*Cc].....[ \t]*\\‍((\\‍)[-+0-9eE\\. \t]*,[-+0-9eE\\. \t]*)"
#define	DCMPLX_RX
#define	DCMPLX2_RX    "^[^\t!*Cc].....[ \t]*\\‍((\\‍)[-+0-9dDeE\\. \t]*,[-+0-9dDeE\\. \t]*)"
#define	GOTO_RX   "g[ \t]*o[ \t]*t[ \t]*o[ \t]*"

Functions
void	pips_get_workspace_list (gen_array_t array)
	Return a sorted arg list of workspace names. More...
void	pips_get_fortran_list (gen_array_t array)
	Select the true file with names ending in ".[fF]" and return a sorted arg list: More...
string	hpfc_generate_path_name_of_file_name (const char *file_name)
	Return the path of an HPFC file name relative to the current PIPS directory. More...
int	hpfc_get_file_list (gen_array_t file_names, char **hpfc_directory_name)
string	pips_change_directory (const char *dir)
	Change to the given directory if it exists and return a canonical name. More...
void	pips_srcpath_set (string path)
	Set the PIPS source path. More...
string	pips_srcpath_append (string pathtoadd)
	returns an allocated pointer to the old value More...
static string	find_file (string name)
	tries several path for a file to include... More...
void	init_processed_include_cache (void)
void	close_processed_include_cache (void)
static string	get_cached (string s)
	Returns the processed cached file name, or null if none. More...
static string	get_new_tmp_file_name (void)
	return an allocated unique cache file name. More...
static bool	handle_file (FILE *, FILE *)
	double recursion (handle_file/handle_file_name) => forwarded declaration. More...
static bool	handle_file_name (FILE *out, char *file_name, bool included)
static bool	handle_include_file (FILE *out, char *file_name)
static void	init_rx (void)
static bool	pips_process_file (string file_name, string new_name)
bool	filter_file (string mod_name)
static bool	zzz_file_p (string s)
	is the file name of the form .../zzz???.f More...
static void	clean_file (string name)
static bool	pips_split_file (string name, string tempfile)
string	preprocessed_to_user_file (string preprocessed_user_file)
	Allocate a new string containing the user file name, before preprocessing. More...
bool	dot_F_file_p (string name)
	Test if a name ends with .F. More...
bool	dot_f_file_p (string name)
	Test if a name ends with .f. More...
bool	dot_f90_file_p (string name)
	Test if a name ends with .f90. More...
bool	dot_f95_file_p (string name)
	Test if a name ends with .f95. More...
bool	dot_c_file_p (string name)
	Test if a name ends with .c. More...
language	workspace_language (gen_array_t files)
	Choose a language if all filenames in "files" have the same C or Fortran extensions. More...
int	find_eol_coding (string name)
	Returns the newly allocated name if preprocessing succeeds. More...
static string	include_path_to_include_flags (string include_path)
static string	process_thru_C_pp (string name)
	Process a file name.c through the C preprocessor to generate a name.cpp_processed.c file. More...
static string	process_thru_fortran_pp (string name)
	Process a ratfor file name.F through the C preprocessor to generate a name.fpp_processed.f file. More...
static string	process_thru_cpp (string name)
	Process a file through a C or Fortran preprocessor according to its type. More...
static bool	pips_check_syntax (string env, string prop)
	Why return an int rather than a bool? More...
static bool	pips_check_fortran (void)
	A Fortran compiler must be run or not before launching the PIPS Fortran parser, according to the environment variable PIPS_CHECK_FORTRAN firstly, and then according to property CHECK_FORTRAN_SYNTAX_BEFORE_RUNNING_PIPS. More...
static bool	pips_check_c (void)
	A C compiler must be run or not before launching the PIPS C parser, according to the environment variable PIPS_CHECK_C firstly, and then according to property CHECK_C_SYNTAX_BEFORE_RUNNING_PIPS. More...
static bool	check_input_file_syntax (string file_name, string compiler, string options, string language)
	Verify that the syntax of a program is correct by running a real compiler on it. More...
static bool	check_fortran_syntax_before_pips (string file_name)
	Verify that the Fortran syntax of a source file is correct by compiling it. More...
static bool	check_c_file_syntax (string file_name)
	Verify that the C syntax of a source file is correct by compiling it. More...
static char *	extract_last_name (char *line)
	"foo bla fun ./e.database/foo.f" -> "./e.database/foo.f" More...
bool	process_user_file (string file)
bool	flag_as_stub (const string module_name)
bool	bootstrap_stubs (const string module_name)

Variables
static string	user_file_directory = NULL
static regex_t	some_goto_rx
static regex_t	implicit_none_rx
static regex_t	include_file_rx
static regex_t	complex_cst_rx
static regex_t	complex_cst2_rx
static regex_t	dcomplex_cst_rx
static regex_t	dcomplex_cst2_rx
static hash_table	processed_cache = hash_table_undefined
	cache of preprocessed includes More...
string	preprocessor_current_split_file_name = string_undefined
	Split a C or Fortran file into as many files as modules. More...
string	preprocessor_current_initial_file_name = string_undefined
	The digestion of a user file by PIPS begins here. More...

Macro Definition Documentation

CMPLX2_RX

#define CMPLX2_RX   "^[^\t!*Cc].....[ \t]*\\‍((\\‍)[-+0-9eE\\. \t]*,[-+0-9eE\\. \t]*)"

Definition at line 233 of file source_file.c.

CMPLX_RX

#define CMPLX_RX   "^[^\t!*Cc].....[^\"']*[^a-zA-Z0-9_ \t][ \t]*\\‍((\\‍)[-+0-9eE\\. \t]*,[-+0-9eE\\. \t]*)"

not recognized: print *, "i = ", (0.,1.) to avoid modifying a character constant...

this stuff should be done by hand in split... also the generated lines may be too long...

Well, the regex can be improved if necessary.

In particular, it does first columned tabbed lines.

Definition at line 230 of file source_file.c.

DCMPLX2_RX

#define DCMPLX2_RX    "^[^\t!*Cc].....[ \t]*\\‍((\\‍)[-+0-9dDeE\\. \t]*,[-+0-9dDeE\\. \t]*)"

Definition at line 240 of file source_file.c.

DCMPLX_RX

#define DCMPLX_RX

Value:

    "^[^\t!*Cc].....[^\"']*[^a-zA-Z0-9_ \t][ \t]*" \
    "\\((\\)[-+0-9dDeE\\. \t]*,[-+0-9dDeE\\. \t]*)"

Definition at line 236 of file source_file.c.

GOTO_RX

#define GOTO_RX   "g[ \t]*o[ \t]*t[ \t]*o[ \t]*"

Definition at line 243 of file source_file.c.

IMPLICIT_NONE_RX

#define IMPLICIT_NONE_RX   "^[ \t]*implicit[ \t]*none"

Definition at line 218 of file source_file.c.

INCLUDE_FILE_RX

#define INCLUDE_FILE_RX   "^[ \t]*include[ \t]*['\"]\\‍([^'\"]*\\‍)['\"]"

Definition at line 219 of file source_file.c.

skip_line_p

#define skip_line_p

(

s

)

((*(s))=='\0' || (*(s))=='!' || (*(s))=='*' || (*(s))=='c' || (*(s))=='C')

include "pipsmake.h"

Definition at line 66 of file source_file.c.

Function Documentation

bootstrap_stubs()

bool bootstrap_stubs

(

const string

module_name

)

Parameters

module_name

odule_name

Definition at line 1344 of file source_file.c.

{
  if (db_resource_p(DBR_STUBS, ""))
    pips_internal_error("kernels already initialized for %s", module_name);
  callees stubs=make_callees(NIL);
  DB_PUT_MEMORY_RESOURCE(DBR_STUBS,"",stubs);
  return true;
}

References DB_PUT_MEMORY_RESOURCE, db_resource_p(), make_callees(), module_name(), NIL, and pips_internal_error.

Referenced by generic_initializer().

Here is the call graph for this function:

Here is the caller graph for this function:

check_c_file_syntax()

static bool check_c_file_syntax ( string  file_name )

static

Verify that the C syntax of a source file is correct by compiling it.

Definition at line 1034 of file source_file.c.

{
  string comp = getenv("PIPS_CC");
  string flags = getenv("PIPS_CPP_FLAGS");
  bool syntax_ok_p = true;
 
  comp = comp? comp: DEFAULT_PIPS_CC;
  flags = flags? flags: DEFAULT_PIPS_CC_FLAGS;
 
  syntax_ok_p = check_input_file_syntax(file_name, comp, flags, "C");
 
  return syntax_ok_p;
}

References check_input_file_syntax(), DEFAULT_PIPS_CC, DEFAULT_PIPS_CC_FLAGS, and file_name.

Referenced by process_user_file().

Here is the call graph for this function:

Here is the caller graph for this function:

check_fortran_syntax_before_pips()

static bool check_fortran_syntax_before_pips ( string  file_name )

static

Verify that the Fortran syntax of a source file is correct by compiling it.

Definition at line 1020 of file source_file.c.

{
  // get compiler & flags...
  string fortran = getenv("PIPS_FLINT");
  if (!fortran) fortran = getenv("PIPS_F77");
  if (!fortran) fortran = DEFAULT_PIPS_FLINT;
  // yes, cpp
  string flags = getenv("PIPS_CPP_FLAGS");
  flags = flags? flags: "";
  return check_input_file_syntax(file_name, fortran, flags, "Fortran");
}

References check_input_file_syntax(), DEFAULT_PIPS_FLINT, and file_name.

Referenced by process_user_file().

Here is the call graph for this function:

Here is the caller graph for this function:

check_input_file_syntax()

static bool check_input_file_syntax ( string  file_name, string  compiler, string  options, string  language  )

static

Verify that the syntax of a program is correct by running a real compiler on it.

string compiler may/must contain the necessary options, e.g. PIPS_CC_FLAGS

pips_user_warning("\n\n %s syntax errors in file \"s"!\007

",

language, file_name);

Hopefully, this new warning is more informative and easier to retrieve as last line in the Warnings file.

Definition at line 981 of file source_file.c.

{
  bool syntax_ok_p = true;
  // SRCPATH has already been used to locate the file and generate a
  // full file name, file_name
  string include_path = getenv(SRCPATH);
  string includes = include_path_to_include_flags(include_path);
 
  user_log("Checking %s syntax of file \"%s\"\n", language, file_name);
 
  // SG: do not forget to protect file_name
  char *pfile_name= strescape(file_name);
  if (safe_system_no_abort
      (concatenate(compiler, " ", options, includes, " ", pfile_name, " ",
      // DO NOT USE A POSSIBLY SHARED FILE NAME!
      // the same "file_name.o" can be used by several creates
      // performed in parallel, for instance by the validation...
                   " -c -o /dev/null", NULL)))
  {
    // Note that TAB is avoided in warning to simplify validation.
    /* pips_user_warning("\n\n        %s syntax errors in file \"%s\"!\007\n\n", */
    /*                   language, file_name); */
    /* Hopefully, this new warning is more informative and easier to
     * retrieve as last line in the Warnings file.
     */
    pips_user_warning("\n\%s syntax errors in source file \"%s\". "
                      "Check source file and/or compilation and preprocessing flags.\n",
                      language, file_name);
    syntax_ok_p = false;
  }
  free(pfile_name);
  free(includes);
  return syntax_ok_p;
}

References concatenate(), file_name, free(), include_path_to_include_flags(), pips_user_warning, safe_system_no_abort(), SRCPATH, strescape(), and user_log().

Referenced by check_c_file_syntax(), and check_fortran_syntax_before_pips().

Here is the call graph for this function:

Here is the caller graph for this function:

clean_file()

static void clean_file ( string  name )

static

drop zzz* files

resize lines[]

keep order for unsplit.

qsort(lines, i, sizeof(char*), cmp);

Definition at line 542 of file source_file.c.

{
    FILE *f;
    string line;
    int i=0, size = 20;
    char ** lines = (char**) malloc(sizeof(char*)*size);
    pips_assert("malloc ok", lines);
 
    f=safe_fopen(name, "r");
    while ((line=safe_readline(f)))
    {
        if (!zzz_file_p(line)) /* drop zzz* files */
        {
            if (i==size) { /* resize lines[] */
                size*=2;
                lines = (char**) realloc(lines, sizeof(char*)*size);
                pips_assert("realloc ok", lines);
            }
            lines[i++]=line;
        }
        else
        {
            unlink(line);
            free(line);
        }
    }
    safe_fclose(f, name);
 
    /* keep order for unsplit. */
    /* qsort(lines, i, sizeof(char*), cmp); */
 
    f=safe_fopen(name, "w");
    while (i>0) {
        fprintf(f, "%s\n", lines[--i]);
        free(lines[i]);
    }
    free(lines);
    safe_fclose(f, name);
}

References f(), fprintf(), free(), line, lines, malloc(), pips_assert, safe_fclose(), safe_fopen(), safe_readline(), and zzz_file_p().

Referenced by pips_split_file().

Here is the call graph for this function:

Here is the caller graph for this function:

close_processed_include_cache()

void close_processed_include_cache

(

void

)

pips may call this without a prior call to init_processed_include_cache under some error conditions, such as a file not found in the initializer, or a failed cpp.

Definition at line 283 of file source_file.c.

{
  //fprintf(stderr, "[close_processed_include_cache] Entering\n");
  if (hash_table_undefined_p(processed_cache))
  {
    /* pips may call this without a prior call to
     * init_processed_include_cache under some error conditions,
     * such as a file not found in the initializer, or a failed cpp.
     */
    /*
      Do not warn the user about PIPS internal architecture issues... :-/
      pips_user_warning("no 'processed include cache' to close, "
      "skipping...\n");
    */
    return;
  }
  pips_assert("defined cache", !hash_table_undefined_p(processed_cache));
  HASH_MAP(k, v, { unlink(v); free(v); }, processed_cache);
  hash_table_free(processed_cache);
  processed_cache = hash_table_undefined;
}

References free(), HASH_MAP, hash_table_free(), hash_table_undefined, hash_table_undefined_p, pips_assert, and processed_cache.

Referenced by check_delete_workspace(), and close_workspace().

Here is the call graph for this function:

Here is the caller graph for this function:

dot_c_file_p()

bool dot_c_file_p

(

string

name

)

Test if a name ends with .c.

Parameters

name

ame

Definition at line 661 of file source_file.c.

                               {
  return !!find_suffix(name, C_FILE_SUFFIX);
}

References find_suffix().

Referenced by get_new_user_file(), pips_split_file(), process_user_file(), and workspace_language().

Here is the call graph for this function:

Here is the caller graph for this function:

dot_f90_file_p()

bool dot_f90_file_p

(

string

name

)

Test if a name ends with .f90.

Parameters

name

ame

Definition at line 649 of file source_file.c.

                                   {
  return !!find_suffix( name, FORTRAN90_FILE_SUFFIX );
}

References find_suffix().

Referenced by create_workspace(), get_new_user_file(), pips_split_file(), process_user_file(), and workspace_language().

Here is the call graph for this function:

Here is the caller graph for this function:

dot_f95_file_p()

bool dot_f95_file_p

(

string

name

)

Test if a name ends with .f95.

Parameters

name

ame

Definition at line 655 of file source_file.c.

                                   {
  return !!find_suffix( name, FORTRAN95_FILE_SUFFIX );
}

References find_suffix().

Referenced by create_workspace(), get_new_user_file(), pips_split_file(), process_user_file(), and workspace_language().

Here is the call graph for this function:

Here is the caller graph for this function:

dot_F_file_p()

bool dot_F_file_p

(

string

name

)

Test if a name ends with .F.

Parameters

name

ame

Definition at line 637 of file source_file.c.

                               {
  return !!find_suffix(name, RATFOR_FILE_SUFFIX);
}

References find_suffix().

Referenced by pips_split_file(), process_thru_cpp(), process_user_file(), and workspace_language().

Here is the call graph for this function:

Here is the caller graph for this function:

dot_f_file_p()

bool dot_f_file_p

(

string

name

)

Test if a name ends with .f.

Parameters

name

ame

Definition at line 643 of file source_file.c.

                               {
  return !!find_suffix(name, FORTRAN_FILE_SUFFIX);
}

References find_suffix().

Referenced by get_new_user_file(), pips_split_file(), process_user_file(), and workspace_language().

Here is the call graph for this function:

Here is the caller graph for this function:

extract_last_name()

static char* extract_last_name ( char *  line )

static

"foo bla fun ./e.database/foo.f" -> "./e.database/foo.f"

look for the two past directory separators

then look for whitespace separated module names

Definition at line 1050 of file source_file.c.

{
#if 1
    /* look for the two past directory separators */
    char * iter = line + strlen(line);
    for(int i =2;i&&iter!=line;--iter) {
        if(*iter=='/') --i;
    }
    /* then look for whitespace separated module names */
    if(iter==line) {
        iter= strrchr(line,' ');
        if(iter) {
            iter[0]=0;
            iter=iter+1;
        }
    }
    else
        iter[-1]=0;
    if(!iter)
        iter=line;
 
    return iter;
#else
        int l = strlen(line);
        do {
               while (l>=0 && line[l]!=' ') l--;
               if (l>=0 && line[l]==' ') line[l]='\0';
           } while (l>=0 && strlen(line+l+1)==0);
        return l>=-1? line+l+1: NULL;
#endif
 
}

References line.

Referenced by process_user_file().

Here is the caller graph for this function:

filter_file()

bool filter_file

(

string

mod_name

)

directory is set for finding includes.

Parameters

mod_name

od_name

Definition at line 501 of file source_file.c.

{
    string name, new_name, dir_name, abs_name, abs_new_name;
    name = db_get_memory_resource(DBR_INITIAL_FILE, mod_name, true);
 
    /* directory is set for finding includes. */
    user_file_directory =
        pips_dirname(db_get_memory_resource(DBR_USER_FILE, mod_name, true));
    new_name = db_build_file_resource_name
        (DBR_SOURCE_FILE, mod_name, FORTRAN_FILE_SUFFIX);
 
    dir_name = db_get_current_workspace_directory();
    abs_name = strdup(concatenate(dir_name, "/", name, NULL));
    abs_new_name = strdup(concatenate(dir_name, "/", new_name, NULL));
    free(dir_name);
 
    if (!pips_process_file(abs_name, abs_new_name))
    {
        pips_user_warning("initial file filtering of %s failed\n", mod_name);
        safe_unlink(abs_new_name);
        free(abs_new_name); free(abs_name);
        return false;
    }
    free(abs_new_name); free(abs_name);
    free(user_file_directory), user_file_directory = NULL;
 
    DB_PUT_NEW_FILE_RESOURCE(DBR_SOURCE_FILE, mod_name, new_name);
    return true;
}

References concatenate(), db_build_file_resource_name(), db_get_current_workspace_directory(), db_get_memory_resource(), DB_PUT_NEW_FILE_RESOURCE, free(), pips_dirname(), pips_process_file(), pips_user_warning, safe_unlink(), strdup(), and user_file_directory.

Here is the call graph for this function:

find_eol_coding()

int find_eol_coding

(

string

name

)

Returns the newly allocated name if preprocessing succeeds.

Returns NULL if preprocessing fails.

Parameters

name

ame

Definition at line 721 of file source_file.c.

{
  FILE * f = safe_fopen(name, "r");
  int state =0;
  int eol_code = -1;
  int c;
 
  while((c=getc(f))!=EOF) {
    if(c=='\n') {
      if(state==1)
        eol_code = 1; // DOS
      else
        eol_code = 0; // UNIX
      break;
    }
    else if(c=='\r')
      state = 1;
    else {
      if(state==1) {
        eol_code = 2; // ISO22
        break;
      }
    }
  }
 
  safe_fclose(f, name);
 
  return eol_code;
}

References f(), safe_fclose(), and safe_fopen().

Referenced by process_thru_C_pp().

Here is the call graph for this function:

Here is the caller graph for this function:

find_file()

static string find_file ( string  name )

static

tries several path for a file to include...

first rely on $PIPS_SRCPATH, then other directories.

Definition at line 257 of file source_file.c.

{
  string srcpath = getenv(SRCPATH), result;
  string path = strdup(concatenate(
                         srcpath? srcpath: "", ":",
                         user_file_directory? user_file_directory: "", ":.:..",
                         NULL));
  result = find_file_in_directories(name, path);
  free(path);
  return result;
}

References concatenate(), find_file_in_directories(), free(), SRCPATH, strdup(), and user_file_directory.

Referenced by handle_file_name().

Here is the call graph for this function:

Here is the caller graph for this function:

flag_as_stub()

bool flag_as_stub

(

const string

module_name

)

Parameters

module_name

odule_name

Definition at line 1334 of file source_file.c.

                                            {
  if (!db_resource_p(DBR_STUBS, ""))
    pips_internal_error("stubs not initialized");
  callees stubs=(callees)db_get_memory_resource(DBR_STUBS,"",true);
  callees_callees(stubs)= CONS(STRING,strdup(module_name),callees_callees(stubs));
  DB_PUT_MEMORY_RESOURCE(DBR_STUBS,"",stubs);
  return true;
 
}

References callees_callees, CONS, db_get_memory_resource(), DB_PUT_MEMORY_RESOURCE, db_resource_p(), module_name(), pips_internal_error, strdup(), and STRING.

Referenced by generic_initializer().

Here is the call graph for this function:

Here is the caller graph for this function:

get_cached()

static string get_cached ( string  s )

static

Returns the processed cached file name, or null if none.

Definition at line 307 of file source_file.c.

{
    string res;
    pips_assert("cache initialized", !hash_table_undefined_p(processed_cache));
    res = hash_get(processed_cache, s);
    //fprintf(stderr, "[close_processed_include_cache] Looking for %s : %s\n", s,
    //res == HASH_UNDEFINED_VALUE ? "NULL" : res);
 
    return res == HASH_UNDEFINED_VALUE ? NULL : res;
}

References hash_get(), hash_table_undefined_p, HASH_UNDEFINED_VALUE, pips_assert, and processed_cache.

Referenced by handle_include_file().

Here is the call graph for this function:

Here is the caller graph for this function:

get_new_tmp_file_name()

static string get_new_tmp_file_name ( void  )

static

return an allocated unique cache file name.

Definition at line 321 of file source_file.c.

{
    static int unique = 0;
    string dir_name, file_name;
    unsigned int len;
    dir_name = db_get_directory_name_for_module(WORKSPACE_TMP_SPACE);
    len = strlen(dir_name)+20;
    file_name = (char*) malloc(sizeof(char)*len);
    if (!file_name) pips_internal_error("malloc failed");
    sprintf(file_name, "%s/cached.%d", dir_name, unique++);
    pips_assert("not too long", strlen(file_name)<len);
    free(dir_name);
    return file_name;
}

References db_get_directory_name_for_module(), file_name, free(), malloc(), pips_assert, pips_internal_error, and WORKSPACE_TMP_SPACE.

Referenced by handle_include_file().

Here is the call graph for this function:

Here is the caller graph for this function:

handle_file()

static bool handle_file ( FILE *  out, FILE *  f  )

static

double recursion (handle_file/handle_file_name) => forwarded declaration.

process f for includes and nones

matched strings

error?

FI: test for parser

handle_complex_constants(&line);

Definition at line 437 of file source_file.c.

{
    string line;
    regmatch_t matches[2]; /* matched strings */
 
    while ((line = safe_readline(f)))
    {
        if (!skip_line_p(line))
        {
            if (!regexec(&include_file_rx, line, 2, matches, 0))
            {
                char c = line[matches[1].rm_eo];
                line[matches[1].rm_eo]='\0';
 
                if (!handle_include_file(out, &line[matches[1].rm_so]))
                    return false; /* error? */
 
                line[matches[1].rm_eo]=c;
                fprintf(out, "! ");
            }
            else if (!regexec(&implicit_none_rx, line, 0, matches, 0))
                    fprintf(out,
                      "! MIL-STD-1753 Fortran extension not in PIPS\n! ");
            else {
                /* FI: test for parser */
                /* handle_complex_constants(&line); */
                ;
            }
        }
        fprintf(out, "%s\n", line);
        free(line);
    }
    return true;
}

References f(), fprintf(), free(), handle_include_file(), implicit_none_rx, include_file_rx, line, matches, out, safe_readline(), and skip_line_p.

Referenced by handle_file_name().

Here is the call graph for this function:

Here is the caller graph for this function:

handle_file_name()

static bool handle_file_name ( FILE *  out, char *  file_name, bool  included  )

static

Do not raise a user_error exception, because you are not in the right directory maybe this is not true anymore? FC 01/04/1998

Definition at line 341 of file source_file.c.

{
    FILE * f;
    string found = find_file(file_name);
    bool ok = false;
 
    if (!found)
    {
        /* Do not raise a user_error exception,
           because you are not in the right directory
           maybe this is not true anymore? FC 01/04/1998
        */
        pips_user_warning("include file %s not found\n", file_name);
        fprintf(out,
                "!! ERROR - include \"%s\" was not found\n"
                "      include \"%s\"\n", file_name, file_name);
        return false;
    }
 
    pips_debug(2, "including file \"%s\"\n", found);
    if (included) fprintf(out, "! include \"%s\"\n", file_name);
 
    f=safe_fopen(found, "r");
    ok = handle_file(out, f);
    safe_fclose(f, found);
 
    if (included) fprintf(out, "! end include \"%s\"\n", file_name);
    free(found);
    return ok;
}

References f(), file_name, find_file(), fprintf(), free(), handle_file(), ok, out, pips_debug, pips_user_warning, safe_fclose(), and safe_fopen().

Referenced by handle_include_file(), and pips_process_file().

Here is the call graph for this function:

Here is the caller graph for this function:

handle_include_file()

static bool handle_include_file ( FILE *  out, char *  file_name  )

static

handle bang comments and hollerith with an additionnal processing...

if ok put in the cache, otherwise drop it.

Definition at line 372 of file source_file.c.

{
    FILE * in;
    bool ok = true;
    string cached = get_cached(file_name);
    char * error = NULL;
 
    if (!cached)
    {
        FILE * tmp_out;
 
        cached = get_new_tmp_file_name();
        tmp_out = safe_fopen(cached, "w");
        ok = handle_file_name(tmp_out, file_name, true);
        safe_fclose(tmp_out, cached);
 
        /* handle bang comments and hollerith with an additionnal
         * processing...
         */
        if (ok)
        {
            string filtered;
            FILE * tmp_hbc, * tmp_in;
 
            filtered = get_new_tmp_file_name();
            tmp_hbc = safe_fopen(filtered, "w");
            tmp_in = safe_fopen(cached, "r");
 
            error = process_bang_comments_and_hollerith(tmp_in, tmp_hbc);
            if (error) ok = false;
 
            safe_fclose(tmp_in, cached);
            safe_fclose(tmp_hbc, filtered);
 
            safe_unlink(cached);
            free(cached);
            cached = filtered;
        }
 
        /* if ok put in the cache, otherwise drop it. */
        if (ok) {
          //fprintf(stderr, "[handle_include_file] Adding in the cache %s for file %s\n",
          //cached, file_name);
          hash_put(processed_cache, file_name, cached);
        }
        else {
          safe_unlink(cached);
          free(cached), cached = NULL;
        }
    }
 
    if (ok)
    {
        in = safe_fopen(cached, "r");
        safe_cat(out, in);
        safe_fclose(in, cached);
    }
 
    if (error) pips_user_error("preprocessing error: %s\n", error);
 
    return ok;
}

References error, file_name, free(), get_cached(), get_new_tmp_file_name(), handle_file_name(), hash_put(), ok, out, pips_user_error, process_bang_comments_and_hollerith(), processed_cache, safe_cat(), safe_fclose(), safe_fopen(), and safe_unlink().

Referenced by handle_file().

Here is the call graph for this function:

Here is the caller graph for this function:

hpfc_generate_path_name_of_file_name()

string hpfc_generate_path_name_of_file_name

(

const char *

file_name

)

Return the path of an HPFC file name relative to the current PIPS directory.

Can be freed by the caller.

Parameters

file_name

ile_name

Definition at line 97 of file source_file.c.

{
  string dir_name = db_get_current_workspace_directory(),
    name = strdup(concatenate(
         dir_name, "/", HPFC_COMPILED_FILE_DIR, "/", file_name, NULL));
  free(dir_name);
  return name;
}

References concatenate(), db_get_current_workspace_directory(), file_name, free(), and strdup().

Referenced by notify_hpfc_file_view().

Here is the call graph for this function:

Here is the caller graph for this function:

hpfc_get_file_list()

int hpfc_get_file_list	(	gen_array_t	file_names,
		char **	hpfc_directory_name
	)

Where is the output of HPFC:

generated files start with upercases

Plain files only:

Parameters

file_names	ile_names
hpfc_directory_name	pfc_directory_name

Definition at line 106 of file source_file.c.

{
  // some static but dynamic buffer.
  static int hpfc_bsz = 0;
  static char * hpfc_dir = NULL;
 
  int return_code, len;
  char * dir = build_pgmwd(db_get_current_workspace_name());
 
  len = strlen(dir) + strlen(HPFC_COMPILED_FILE_DIR) + 5;
 
  if (hpfc_bsz<len) {
    if (hpfc_dir) free(hpfc_dir), hpfc_dir=NULL;
    hpfc_bsz = len;
    hpfc_dir = (char*) malloc(hpfc_bsz);
    message_assert("malloc succeeded", hpfc_dir);
  }
 
  // Get the HPFC file name list:
  sprintf(hpfc_dir, "%s/%s", dir, HPFC_COMPILED_FILE_DIR);
 
  return_code = safe_list_files_in_directory(
    file_names,
    hpfc_dir, /* Where is the output of HPFC: */
    "^[A-Z].*\\.[fh]$", /* generated files start with upercases */
    file_exists_p /* Plain files only: */);
  *hpfc_directory_name = hpfc_dir;
 
  return return_code;
}

References build_pgmwd, db_get_current_workspace_name(), file_exists_p(), free(), malloc(), message_assert, and safe_list_files_in_directory().

Referenced by generate_a_menu_with_HPF_output_files().

Here is the call graph for this function:

Here is the caller graph for this function:

include_path_to_include_flags()

static string include_path_to_include_flags ( string  include_path )

static

At least include files from the current directory:

Transform the include path p1:p2:... into -Ip1 -Ip2...

Definition at line 751 of file source_file.c.

{
  /* At least include files from the current directory: */
  string includes = strdup("");
 
  /* Transform the include path p1:p2:... into -Ip1 -Ip2...*/
  for(int i = 0;; i++) {
    // Get the path i:
    string p = nth_path(include_path, i);
    if (p == NULL)
      // No more directory
      break;
    string old_includes = includes;
    includes = strdup(concatenate(includes, " -I", p, NULL));
    free(p);
    free(old_includes);
  }
  return includes;
}

References concatenate(), free(), nth_path(), and strdup().

Referenced by check_input_file_syntax(), and process_thru_C_pp().

Here is the call graph for this function:

Here is the caller graph for this function:

init_processed_include_cache()

void init_processed_include_cache

(

void

)

Definition at line 272 of file source_file.c.

{
  // Since these functions are called in different context, the
  // conventional pips_debug() is not well suitable, so revert to plain
  // old fprintf for debug...
  //fprintf(stderr, "[init_processed_include_cache] Entering\n");
  pips_assert("undefined cache", hash_table_undefined_p(processed_cache));
  processed_cache = hash_table_make(hash_string, 100);
}

References hash_string, hash_table_make(), hash_table_undefined_p, pips_assert, and processed_cache.

Referenced by create_workspace(), and open_workspace().

Here is the call graph for this function:

Here is the caller graph for this function:

init_rx()

static void init_rx ( void  )

static

Definition at line 472 of file source_file.c.

{
    static bool done=false;
    if (done) return;
    done=true;
    if (regcomp(&some_goto_rx, GOTO_RX, REG_ICASE)              ||
        regcomp(&implicit_none_rx, IMPLICIT_NONE_RX, REG_ICASE) ||
        regcomp(&include_file_rx, INCLUDE_FILE_RX, REG_ICASE)   ||
        regcomp(&complex_cst_rx, CMPLX_RX, REG_ICASE)           ||
        regcomp(&complex_cst2_rx, CMPLX2_RX, REG_ICASE)         ||
        regcomp(&dcomplex_cst_rx, DCMPLX_RX, REG_ICASE)         ||
        regcomp(&dcomplex_cst2_rx, DCMPLX2_RX, REG_ICASE))
        pips_internal_error("invalid regular expression");
}

References CMPLX2_RX, CMPLX_RX, complex_cst2_rx, complex_cst_rx, DCMPLX2_RX, DCMPLX_RX, dcomplex_cst2_rx, dcomplex_cst_rx, GOTO_RX, IMPLICIT_NONE_RX, implicit_none_rx, INCLUDE_FILE_RX, include_file_rx, pips_internal_error, and some_goto_rx.

Referenced by pips_process_file().

Here is the caller graph for this function:

pips_change_directory()

string pips_change_directory

(

const char *

dir

)

Change to the given directory if it exists and return a canonical name.

Return NULL if it does not exist, or fails

Parameters

dir

ir

Definition at line 142 of file source_file.c.

{
  if (directory_exists_p(dir))
  {
    int status = chdir(dir);
    if (status==-1)
    {
      perror("chdir");
      return NULL;
    }
    // should check status...
    return get_cwd();
  }
  return NULL;
}

References directory_exists_p(), and get_cwd().

Referenced by end_directory_notify().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_check_c()

static bool pips_check_c ( void  )

static

A C compiler must be run or not before launching the PIPS C parser, according to the environment variable PIPS_CHECK_C firstly, and then according to property CHECK_C_SYNTAX_BEFORE_RUNNING_PIPS.

So the environment overrides the property.

Definition at line 968 of file source_file.c.

{
  string env = "PIPS_CHECK_C";
  string prop = "CHECK_C_SYNTAX_BEFORE_RUNNING_PIPS";
  return pips_check_syntax(env, prop);
}

References env, and pips_check_syntax().

Referenced by process_user_file().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_check_fortran()

static bool pips_check_fortran ( void  )

static

A Fortran compiler must be run or not before launching the PIPS Fortran parser, according to the environment variable PIPS_CHECK_FORTRAN firstly, and then according to property CHECK_FORTRAN_SYNTAX_BEFORE_RUNNING_PIPS.

So the environment overrides the property.

Definition at line 955 of file source_file.c.

{
  string env = "PIPS_CHECK_FORTRAN";
  string prop = "CHECK_FORTRAN_SYNTAX_BEFORE_RUNNING_PIPS";
  return pips_check_syntax(env, prop);
}

References env, and pips_check_syntax().

Referenced by process_user_file().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_check_syntax()

static bool pips_check_syntax ( string  env, string  prop  )

static

Why return an int rather than a bool?

Definition at line 932 of file source_file.c.

{
  // environment has the priority
  string v = getenv(env);
 
  if (v && (*v=='o' || *v=='y' || *v=='t' || *v=='v' || *v=='1' ||
            *v=='O' || *v=='Y' || *v=='T' || *v=='V'))
    return true;
 
  if (v && (*v=='n' || *v=='f'  || *v=='0' || *v=='N' || *v=='F' ))
    return false;
 
  // else look for the property
  return get_bool_property(prop);
}

References env, and get_bool_property().

Referenced by pips_check_c(), and pips_check_fortran().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_get_fortran_list()

void pips_get_fortran_list

(

gen_array_t

array

)

Select the true file with names ending in ".[fF]" and return a sorted arg list:

Parameters

array

rray

Definition at line 89 of file source_file.c.

{
  list_files_in_directory(array, ".", "^.*\\.[fF]$", file_exists_p);
}

References array, file_exists_p(), and list_files_in_directory().

Referenced by continue_create_workspace_notify().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_get_workspace_list()

void pips_get_workspace_list

(

gen_array_t

array

)

Return a sorted arg list of workspace names.

cproto-generated files

(For each name, there is a name.database directory in the current directory):

Parameters

array

rray

Definition at line 74 of file source_file.c.

{
  int i, n;
  // Find all directories with name ending with ".database":
  list_files_in_directory(array, ".", "^.*\\.database$", directory_exists_p);
  n = gen_array_nitems(array);
  // Remove the ".database":
  for (i = 0; i < n; i++) {
    *strchr(gen_array_item(array, i), '.') = '\0';
  }
}

References array, directory_exists_p(), gen_array_item(), gen_array_nitems(), and list_files_in_directory().

Referenced by generate_workspace_menu(), open_or_create_workspace(), open_workspace_notify(), and start_delete_workspace_notify().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_process_file()

static bool pips_process_file ( string  file_name, string  new_name  )

static

Definition at line 487 of file source_file.c.

{
    bool ok = false;
    FILE * out;
    pips_debug(2, "processing file %s\n", file_name);
    init_rx();
    out = safe_fopen(new_name, "w");
    ok = handle_file_name(out, file_name, false);
    safe_fclose(out, new_name);
    return ok;
}

References file_name, handle_file_name(), init_rx(), ok, out, pips_debug, safe_fclose(), and safe_fopen().

Referenced by filter_file().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_split_file()

static bool pips_split_file ( string  name, string  tempfile  )

static

Definition at line 586 of file source_file.c.

{
  char * err = NULL;
  FILE * out = safe_fopen(tempfile, "w");
  string dir = db_get_current_workspace_directory();
  preprocessor_current_split_file_name = strdup(name);
 
  if ( dot_c_file_p( name ) )
    err = csplit( dir, name, out );
  else if ( dot_f_file_p( name ) || dot_F_file_p( name ) )
    err = fsplit( dir, name, out );
  else if ( dot_f90_file_p( name ) || dot_f95_file_p( name ) )
    err = f95split( dir, name, &out );
  else
    pips_user_error("unexpected file name for splitting: %s", name);
 
  free(dir);
  free(preprocessor_current_split_file_name);
  safe_fclose(out, tempfile);
  clean_file(tempfile);
  if (err) {
    fprintf(stderr, "split error while extracting %s from %s: %s\n",
            tempfile, name, err);
  }
  return err != NULL;
}

References clean_file(), csplit(), db_get_current_workspace_directory(), dot_c_file_p(), dot_f90_file_p(), dot_f95_file_p(), dot_F_file_p(), dot_f_file_p(), f95split(), fprintf(), free(), fsplit(), out, pips_user_error, preprocessor_current_split_file_name, safe_fclose(), safe_fopen(), and strdup().

Referenced by process_user_file().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_srcpath_append()

string pips_srcpath_append

(

string

pathtoadd

)

returns an allocated pointer to the old value

Strdup the string since it is returned and use later in many other places

Parameters

pathtoadd

athtoadd

Definition at line 177 of file source_file.c.

{
  string old_path, new_path;
  old_path = getenv(SRCPATH);
  if (old_path)
    /* Strdup the string since it is returned and use later in many other
       places */
    old_path = strdup(old_path);
  new_path = concatenate(old_path? old_path: "", old_path? ":": "",
                         pathtoadd, NULL);
  pips_srcpath_set(new_path);
  return old_path;
}

References concatenate(), pips_srcpath_set(), SRCPATH, and strdup().

Referenced by parse_arguments(), and step_analyse_init().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_srcpath_set()

void pips_srcpath_set

(

string

path

)

Set the PIPS source path.

Parameters

path	is used to set the search path or to unset if path is NULL

Strangely this environment variable is set many times in PIPS to pass some information...

Parameters

path

ath

Definition at line 167 of file source_file.c.

{
  if (path)
    setenv(SRCPATH, path, true);
  else
    unsetenv(SRCPATH);
}

References SRCPATH.

Referenced by parse_arguments(), pips_srcpath_append(), pop_path(), and safe_pop_path().

Here is the caller graph for this function:

preprocessed_to_user_file()

string preprocessed_to_user_file

(

string

preprocessed_user_file

)

Allocate a new string containing the user file name, before preprocessing.

No preprocessing has occured

Parameters

preprocessed_user_file

reprocessed_user_file

Definition at line 617 of file source_file.c.

{
  string user_file = strdup(preprocessed_user_file);
  string suffix = string_undefined;
 
  if ((suffix = find_suffix(user_file, PP_FORTRAN_ED)) != NULL) {
    strcpy(suffix, FORTRAN_FILE_SUFFIX);
  }
  else if((suffix = find_suffix(user_file, PP_C_ED)) != NULL) {
    strcpy(suffix, C_FILE_SUFFIX);
  }
  else {
    /* No preprocessing has occured */
    ;
  }
  return user_file;
}

References find_suffix(), strdup(), string_undefined, and user_file.

Referenced by get_new_user_file().

Here is the call graph for this function:

Here is the caller graph for this function:

process_thru_C_pp()

static string process_thru_C_pp ( string  name )

static

Process a file name.c through the C preprocessor to generate a name.cpp_processed.c file.

Parameters

name	is the name of the file to process

Returns

the name of the produced file

check "test" could be performed before "cat" but not after, and the error file may be useful for the user. Why should we remove it so soon?

        " && test ! -s ", cpp_err,
        " && rm -f ", cpp_err, NULL)); 

Sed command to replace the second occurence of the formal parameter __x of the functions used twice on the same line by __y. Examples from math.h: extern long double fabsl (long double __x) ; extern long double __fabsl (long double __x); will be replace by extern long double fabsl (long double __x) ; extern long double __fabsl (long double __y);

check "test" could be performed before "cat" but not after, and the error file may be useful for the user. Why should we remove it so soon?

" && test ! -s ", cpp_err, " && rm -f ", cpp_err, NULL));

Definition at line 778 of file source_file.c.

                                             {
  string dir_name, new_name, simpler, cpp_options, cpp, cpp_err;
  int status = 0;
  string include_path = getenv(SRCPATH);
  // To manage file encoding
  int eol_code = -1;
 
  dir_name = db_get_directory_name_for_module(WORKSPACE_TMP_SPACE);
  // FI: generates conflicts when several source files have the same name
  //simpler = pips_basename(name, C_FILE_SUFFIX);
  simpler = pips_initial_filename(name, C_FILE_SUFFIX);
  new_name = strdup(concatenate(dir_name, "/", simpler, PP_C_ED, NULL));
  cpp_err  = strescape(concatenate(new_name, PP_ERR, NULL));
  free(dir_name);
  free(simpler);
 
  cpp = getenv(CPP_PIPS_ENV);
  cpp_options = getenv(CPP_PIPS_OPTIONS_ENV);
 
  string includes = include_path_to_include_flags(include_path);
 
  pips_debug(1, "PIPS_SRCPATH=\"%s\"\n", include_path);
  pips_debug(1, "INCLUDE=\"%s\"\n", includes);
 
  eol_code = find_eol_coding(name);
  eol_code = 0;
 
  if (eol_code>0)
    pips_user_error(
      "EOL encoding for file \"%s\" is \"%s\" and not supported\n",
      name, eol_code==1? "dos" : "iso22");
 
  status = safe_system_no_abort
    (concatenate(cpp? cpp: CPP_CPP,
                 CPP_CPPFLAGS, cpp_options? cpp_options: "",
                 includes, " '",
                 name, "' > '", new_name, "' 2> ", cpp_err, NULL));
 
  free(includes);
 
    if(status) {
      (void) safe_system_no_abort(concatenate("cat ", cpp_err, NULL));
 
      /* check "test" could be performed before "cat" but not after, and
         the error file may be useful for the user. Why should we remove
         it so soon?
 
                            " && test ! -s ", cpp_err,
                            " && rm -f ", cpp_err, NULL)); */
      free(new_name);
      new_name = NULL;
    }
/* Sed command to replace the second occurence of the formal parameter __x of the functions
     used twice on the same line by __y.
     Examples from math.h:
     extern long double fabsl (long double __x) ; extern long double __fabsl (long double __x);
     will be replace by 
     extern long double fabsl (long double __x) ; extern long double __fabsl (long double __y);
  */
    if (status==0) {
      status = safe_system_no_abort
        (concatenate("sed -i -e \"s/(long double __x) ;/(long double __y);/2g\" '",
                     new_name, "' 2> ", cpp_err, NULL));
 
      if(status) {
        (void) safe_system_no_abort(concatenate("cat ", cpp_err, NULL));
 
        /* check "test" could be performed before "cat" but not after, and
           the error file may be useful for the user. Why should we remove
           it so soon?
 
           " && test ! -s ", cpp_err,
           " && rm -f ", cpp_err, NULL)); */
        free(new_name);
        new_name = NULL;
      }
    }
    free(cpp_err);
 
    return new_name;
}

References concatenate(), CPP_CPP, CPP_CPPFLAGS, CPP_PIPS_ENV, CPP_PIPS_OPTIONS_ENV, db_get_directory_name_for_module(), find_eol_coding(), free(), include_path_to_include_flags(), pips_debug, pips_initial_filename(), pips_user_error, safe_system_no_abort(), SRCPATH, strdup(), strescape(), and WORKSPACE_TMP_SPACE.

Referenced by process_thru_cpp().

Here is the call graph for this function:

Here is the caller graph for this function:

process_thru_cpp()

static string process_thru_cpp ( string  name )

static

Process a file through a C or Fortran preprocessor according to its type.

Not much to share between .F and .c?

Definition at line 916 of file source_file.c.

{
  /* Not much to share between .F and .c? */
  string new_name = string_undefined;
 
  if(dot_F_file_p(name))
    new_name = process_thru_fortran_pp(name);
  else
    new_name = process_thru_C_pp(name);
 
  return new_name;
}

References dot_F_file_p(), process_thru_C_pp(), process_thru_fortran_pp(), and string_undefined.

Referenced by process_user_file().

Here is the call graph for this function:

Here is the caller graph for this function:

process_thru_fortran_pp()

static string process_thru_fortran_pp ( string  name )

static

Process a ratfor file name.F through the C preprocessor to generate a name.fpp_processed.f file.

Note: the preprocessor used must know somehow about Fortran and its lexical and comment conventions. This is ok with gcc when g77 or gfortran is included. Otherwise, "'" appearing in Fortran comments results in errors to be reported. Well, the return code could be ignored maybe, but I prefer not to.

FI->FC: it should be a safe_system_no_abort(). Errors are supposedly displayed... but their display is skipped because of the return code of the first process and pips_internal_error is executed!. PIPS_SRCPATH is not used to find the include files. A pips_user_error is not caught at the process_user_file level.

See preprocessor/Validation/csplit09.tpips

fpp was wrong...

show errors

Definition at line 863 of file source_file.c.

{
    string dir_name, new_name, simpler, fpp_options, fpp, fpp_err;
    int status;
 
    dir_name = db_get_directory_name_for_module(WORKSPACE_TMP_SPACE);
    simpler = pips_basename(name, RATFOR_FILE_SUFFIX);
    new_name = strdup(concatenate(dir_name, "/", simpler, PP_FORTRAN_ED, NULL));
    fpp_err  = strdup(concatenate(new_name, PP_ERR, NULL));
    free(dir_name);
    free(simpler);
 
    fpp = getenv(FPP_PIPS_ENV);
    fpp_options = getenv(FPP_PIPS_OPTIONS_ENV);
 
    /* Note: the preprocessor used **must** know somehow about Fortran and
     * its lexical and comment conventions. This is ok with gcc when g77
     * or gfortran is included. Otherwise, "'" appearing in Fortran
     * comments results in errors to be reported.  Well, the return code
     * could be ignored maybe, but I prefer not to.
     */
 
    /* FI->FC: it should be a safe_system_no_abort(). Errors are
       supposedly displayed... but their display is skipped because of the
       return code of the first process and pips_internal_error is
       executed!. PIPS_SRCPATH is not used to find the include files. A
       pips_user_error is not caught at the process_user_file level.
 
       See preprocessor/Validation/csplit09.tpips */
 
    status = safe_system_no_abort(concatenate(fpp? fpp: FPP_CPP,
                                 FPP_CPPFLAGS, fpp_options? fpp_options: "",
                                 " ", name, " > ", new_name, " 2> ", fpp_err,
                                 " && cat ", fpp_err,
                                 " && test ! -s ", fpp_err,
                                 " && rm -f ", fpp_err, NULL));
 
    /* fpp was wrong... */
    if (status)
    {
      /* show errors */
      (void) safe_system_no_abort(concatenate("cat ", fpp_err, NULL));
      free(new_name);
      new_name = NULL;
    }
 
    free(fpp_err);
    return new_name;
}

References concatenate(), db_get_directory_name_for_module(), FPP_CPP, FPP_CPPFLAGS, FPP_PIPS_ENV, FPP_PIPS_OPTIONS_ENV, free(), pips_basename(), safe_system_no_abort(), strdup(), and WORKSPACE_TMP_SPACE.

Referenced by process_thru_cpp().

Here is the call graph for this function:

Here is the caller graph for this function:

process_user_file()

bool process_user_file

(

string

file

)

The file is looked for in the pips source path.

Do not check the syntax in the input file: quite dangerous in case it is wrong because PIPS is not designed to work on damaged source codes. But this may be useful is the input file is a validation file or if the input file has already been checked.

If two modules have the same name, the first splitted wins and the other one is hidden by the call since fsplit gives it a zzz00n.f name Let's hope no user module is called ###???.f

The newly created module files are registered in the database The file_list allows split to communicate with this function.

a_line: "MODULE1 ... MODULEn file_name"

The list modules comes from entries that might be included in the subroutine.

For each Fortran module in the line, put the initial_file and user_file resource. In C, line should have only one entry and a C source file and a user file resources are created.

hey, that's cleaning!

Seems to be recorded as a resource, causes problems later when closing the workspace...

unlink(nfile);

Parameters

file

ile

Definition at line 1090 of file source_file.c.

{
  bool success_p = false, cpp_processed_p;
  string dir_name = db_get_current_workspace_directory();
 
  // FC: hmmm this function is not very strict,
  // and sometime we need clean user errors...
  bool generate_user_error =
    get_bool_property("ABORT_ON_USER_ERROR") ||
    get_bool_property("CLOSE_WORKSPACE_AND_QUIT_ON_ERROR");
 
  static int number_of_files = 0;
  static int number_of_modules = 0;
  static int resource_name_conflicts = 0;
 
  number_of_files++;
  pips_debug(1, "file %s (number %d)\n", file, number_of_files);
 
  /* The file is looked for in the pips source path.
   */
  string nfile = find_file_in_directories(file, getenv(SRCPATH));
 
  if (!nfile)
  {
    pips_user_error("Cannot open file: \"%s\"", file);
    return false;
  }
 
  string initial_file = nfile;
  preprocessor_current_initial_file_name = nfile;
 
  // The new file is registered (well, not really...) in the database.
  user_log("Registering file %s\n", file);
 
  bool syntax_ok_p = true;
  if ((dot_F_file_p(nfile) || dot_f_file_p(nfile)) && pips_check_fortran())
  {
    // Note: a Fortran compiler is required on the machine.
    syntax_ok_p = check_fortran_syntax_before_pips(nfile);
  }
  else if (dot_c_file_p(nfile) && pips_check_c()) {
    // Note: a C compiler is required on the machine. Run it.
    syntax_ok_p = check_c_file_syntax(nfile);
  }
  else
  {
    /* Do not check the syntax in the input file: quite dangerous in
       case it is wrong because PIPS is not designed to work on
       damaged source codes. But this may be useful is the input file
       is a validation file or if the input file has already been
       checked. */
    pips_debug(1, "No syntactic check on file \"%s\"\n", nfile);
  }
 
  if (!syntax_ok_p)
  {
    if (generate_user_error)
      pips_user_error("Syntax check failed on \"%s\"", nfile);
    // It is up to the caller to decide if the syntax must be checked
    // for other files as well
    return false;
  }
 
  // CPP if file extension is .F or .c
  // (assumes string_equal_p(nfile, initial_file))
  cpp_processed_p = dot_F_file_p(nfile) || dot_c_file_p(nfile);
 
  if (cpp_processed_p)
  {
    user_log("Preprocessing file %s\n", initial_file);
    nfile = process_thru_cpp(initial_file);
    if (nfile==NULL)
    {
      if (generate_user_error)
        pips_user_error("Cannot preprocess file \"%s\"", initial_file);
      else
        pips_user_warning("Cannot preprocess file: %s\n", initial_file);
      return false;
    }
  }
  else if ( !dot_f_file_p( nfile ) && !dot_f90_file_p( nfile )
              && !dot_f95_file_p( nfile ) ) {
    pips_user_error("Unexpected file extension\n");
  }
 
  /* If two modules have the same name, the first splitted wins
   * and the other one is hidden by the call since fsplit gives
   * it a zzz00n.f name
   * Let's hope no user module is called ###???.f
   */
  string file_list =
    strdup(concatenate(dir_name,
                       dot_c_file_p(nfile)?
                       "/.csplit_file_list" : "/.fsplit_file_list", NULL));
  unlink(file_list);
 
  user_log("Splitting file    %s\n", nfile);
  if (pips_split_file(nfile, file_list))
  {
    if (generate_user_error)
      pips_user_error("error while splitting file \"%s\"", nfile);
    return false;
  }
 
  /* The newly created module files are registered in the database
   * The file_list allows split to communicate with this function.
   */
  FILE * fd = safe_fopen(file_list, "r");
  string a_line;
  while ((a_line = safe_readline(fd)) && resource_name_conflicts == 0)
  {
    string mod_name = NULL, res_name = NULL;
    list modules = NIL;
    bool renamed=false;
 
    /* a_line: "MODULE1 ... MODULEn file_name"
     *
     * The list modules comes from entries that might be included
     * in the subroutine.
     */
    string file_name = extract_last_name(a_line);
    success_p = true;
    number_of_modules++;
    pips_debug(2, "module %s (number %d)\n", file_name, number_of_modules);
 
    while (mod_name!=a_line && (mod_name = extract_last_name(a_line)))
      modules = CONS(STRING, mod_name, modules);
 
    /* For each Fortran module in the line, put the initial_file and
       user_file resource. In C, line should have only one entry and a C
       source file and a user file resources are created. */
    FOREACH(STRING, mod_name, modules)
    {
      user_log("  Module         %s\n", mod_name);
 
      if (!renamed)
      {
        FILE * rf = NULL;
 
        if (dot_c_file_p(nfile)) {
          res_name = db_build_file_resource_name
            (DBR_C_SOURCE_FILE, mod_name, C_FILE_SUFFIX);
        }
        else {
          res_name = db_build_file_resource_name
            (DBR_INITIAL_FILE, mod_name, FORTRAN_INITIAL_FILE_SUFFIX);
        }
 
        string abs_res = strdup(concatenate(dir_name, "/", res_name, NULL));
 
        if ((rf = fopen(abs_res, "r"))!=NULL)
        { // Resource name conflict
          string ofile =
            db_get_memory_resource(DBR_USER_FILE, mod_name, true);
 
          fclose(rf);
          pips_user_warning("Duplicate module name \"%s\""
                            " from files \"%s\" and \"%s\".\n",
                            res_name, ofile, nfile);
          resource_name_conflicts++;
          break;
        }
 
        if (rename(file_name, abs_res))
          pips_internal_error("mv %s %s failed", file_name, res_name);
        renamed = true;
        free(abs_res);
      }
 
      if(dot_c_file_p(nfile)) {
        DB_PUT_NEW_FILE_RESOURCE(DBR_C_SOURCE_FILE, mod_name,
                                 strdup(res_name));
        DB_PUT_NEW_FILE_RESOURCE(DBR_INPUT_FILE_NAME, mod_name,
                                 strdup(initial_file));
      }
      else {
        DB_PUT_NEW_FILE_RESOURCE(DBR_INITIAL_FILE, mod_name,
                                 strdup(res_name));
      }
      // from which file the initial source was derived.
      // absolute path to the file so that db moves should be ok?
      DB_PUT_NEW_FILE_RESOURCE(DBR_USER_FILE, mod_name, strdup(nfile));
 
      if ( dot_f90_file_p( nfile ) || dot_f95_file_p( nfile ) )
      {
        char *parsedcode_filename =
          get_resource_file_name(DBR_PARSED_CODE, mod_name);
        FILE *parsedcode_file = safe_fopen( parsedcode_filename, "r" );
        DB_PUT_NEW_FILE_RESOURCE(DBR_PARSED_CODE, mod_name,
                                 gen_read( parsedcode_file ));
        safe_fclose( parsedcode_file, parsedcode_filename );
        char *callees_filename =
          get_resource_file_name( DBR_CALLEES, mod_name );
        FILE *callees_file = safe_fopen( callees_filename, "r" );
        DB_PUT_NEW_FILE_RESOURCE(DBR_CALLEES, mod_name,
                                 gen_read( callees_file ) );
        safe_fclose( callees_file, callees_filename );
        string source_file_name =
          strdup(concatenate(dir_name, "/", mod_name, "/", mod_name, ".f90",
                             NULL));
        DB_PUT_NEW_FILE_RESOURCE( DBR_SOURCE_FILE, mod_name, source_file_name );
      }
    }
 
    gen_free_list(modules), modules=NIL;
 
    if (res_name) free(res_name), res_name = NULL;
    free(a_line);
  }
 
  safe_fclose(fd, file_list);
  unlink(file_list);
  free(file_list);
  free(dir_name);
 
  if (cpp_processed_p) {
    free(initial_file); /* hey, that's cleaning! */
    preprocessor_current_initial_file_name = string_undefined;
  }
 
  if (!success_p)
  {
    // empty file... ???
    pips_user_warning("No module was found when splitting file %s.\n", nfile);
  }
 
  if (cpp_processed_p) {
    // nfile is not the initial file
    pips_debug(1, "Remove output of preprocessing: %s\n", nfile);
    /* Seems to be recorded as a resource, causes problems later when
       closing the workspace... */
    /* unlink(nfile); */
  }
  free(nfile);
 
  // well, returns ok whether modules were found or not,
  // but do not accept name conflicts.
  return resource_name_conflicts==0;
}

References check_c_file_syntax(), check_fortran_syntax_before_pips(), concatenate(), CONS, db_build_file_resource_name(), db_get_current_workspace_directory(), db_get_memory_resource(), DB_PUT_NEW_FILE_RESOURCE, dot_c_file_p(), dot_f90_file_p(), dot_f95_file_p(), dot_F_file_p(), dot_f_file_p(), extract_last_name(), file_name, find_file_in_directories(), FOREACH, free(), gen_free_list(), gen_read(), get_bool_property(), get_resource_file_name(), NIL, pips_check_c(), pips_check_fortran(), pips_debug, pips_internal_error, pips_split_file(), pips_user_error, pips_user_warning, preprocessor_current_initial_file_name, process_thru_cpp(), safe_fclose(), safe_fopen(), safe_readline(), SRCPATH, strdup(), STRING, string_undefined, and user_log().

Referenced by add_a_file(), ask_a_missing_file(), create_workspace(), retrieve_a_missing_file_using_external_resolver(), and retrieve_a_missing_file_using_internal_resolver().

Here is the call graph for this function:

Here is the caller graph for this function:

workspace_language()

language workspace_language

(

gen_array_t

files

)

Choose a language if all filenames in "files" have the same C or Fortran extensions.

Parameters

files

iles

Definition at line 667 of file source_file.c.

{
  int i, argc = gen_array_nitems(files);
  language l = language_undefined;
  int n_fortran = 0;
  int n_fortran95 = 0;
  int n_c = 0;
 
  for (i = 0; i < argc; i++) {
    string fn = gen_array_item(files, i);
    if(dot_F_file_p(fn) || dot_f_file_p(fn))
      n_fortran++;
    else if(dot_c_file_p(fn))
      n_c++;
    else if(dot_f90_file_p(fn) || dot_f95_file_p(fn)){
      n_fortran95++;
    } else {
      ;
    }
  }
 
  if(n_fortran>0 && n_fortran95==0 && n_c==0) {
    l = make_language_fortran();
  } else if(n_fortran==0 && n_fortran95>0 && n_c==0) {
    l = make_language_fortran95();
  } else if(n_fortran==0 && n_fortran95==0 && n_c>0) {
    l = make_language_c();
  } else {
    l = make_language_unknown();
  }
 
  return l;
}

References dot_c_file_p(), dot_f90_file_p(), dot_f95_file_p(), dot_F_file_p(), dot_f_file_p(), gen_array_item(), gen_array_nitems(), language_undefined, make_language_c(), make_language_fortran(), make_language_fortran95(), and make_language_unknown().

Referenced by add_a_file(), and create_workspace().

Here is the call graph for this function:

Here is the caller graph for this function:

zzz_file_p()

static bool zzz_file_p ( string  s )

static

is the file name of the form .../zzz???.f

Definition at line 535 of file source_file.c.

{
  int len = strlen(s)-1;
  return len>=8 && s[len-8]=='/' && s[len-7]=='#' && s[len-6]=='#' &&
    s[len-5]=='#' && s[len-1]=='.' && s[len]=='f';
}

Referenced by clean_file().

Here is the caller graph for this function:

Variable Documentation

complex_cst2_rx

regex_t complex_cst2_rx

static

Definition at line 250 of file source_file.c.

Referenced by init_rx().

complex_cst_rx

regex_t complex_cst_rx

static

Definition at line 249 of file source_file.c.

Referenced by init_rx().

dcomplex_cst2_rx

regex_t dcomplex_cst2_rx

static

Definition at line 252 of file source_file.c.

Referenced by init_rx().

dcomplex_cst_rx

regex_t dcomplex_cst_rx

static

Definition at line 251 of file source_file.c.

Referenced by init_rx().

implicit_none_rx

regex_t implicit_none_rx

static

Definition at line 247 of file source_file.c.

Referenced by handle_file(), and init_rx().

include_file_rx

regex_t include_file_rx

static

Definition at line 248 of file source_file.c.

Referenced by handle_file(), and init_rx().

preprocessor_current_initial_file_name

string preprocessor_current_initial_file_name = string_undefined

The digestion of a user file by PIPS begins here.

The file is searched in the SRCPATH directories.

Definition at line 1088 of file source_file.c.

Referenced by csplit_copy(), csplit_parser_warning_alist(), and process_user_file().

preprocessor_current_split_file_name

string preprocessor_current_split_file_name = string_undefined

Split a C or Fortran file into as many files as modules.

Definition at line 584 of file source_file.c.

Referenced by csplit_parser_warning_alist(), and pips_split_file().

processed_cache

hash_table processed_cache = hash_table_undefined

static

cache of preprocessed includes

Definition at line 271 of file source_file.c.

Referenced by close_processed_include_cache(), get_cached(), handle_include_file(), and init_processed_include_cache().

some_goto_rx

regex_t some_goto_rx

static

Definition at line 246 of file source_file.c.

Referenced by init_rx().

user_file_directory

string user_file_directory = NULL

static

Definition at line 194 of file source_file.c.

Referenced by filter_file(), and find_file().