gfc2pips-util.c File Reference

#include "gfc2pips-private.h"
#include "c_parser_private.h"
#include "misc.h"
#include "text-util.h"
#include <stdio.h>

Include dependency graph for gfc2pips-util.c:

Go to the source code of this file.

Functions
list	gen_union (list a, list b)
	generate an union of unique elements taken from A and B More...
void	gfc2pips_add_to_callees (entity e)
	Add an entity to the list of callees. More...
char *	str2upper (char s[])
	Here are few utility functions to handle splitted files and do comparisons with case insensitive. More...
char *	strn2upper (char s[], size_t n)
	replace lower case char by upper case ones More...
char *	strrcpy (char *dest, __const char *src)
	copy a string from the last char (to allow copy on itself) More...
int	strcmp_ (__const char *__s1, __const char *__s2)
	insensitive case comparison More...
int	strncmp_ (__const char *__s1, __const char *__s2, size_t __n)
	insensitive case n-comparison More...
int	fcopy (const char *old, const char *new)
	copy the file called *old to the file called *new More...
void	gfc2pips_truncate_useless_zeroes (char *s)
	expurgates a string representing a REAL, could be a pre-prettyprinter processing More...
void	load_entities ()
void	save_entities ()
void	pips_init ()
void	gfc2pips_get_use_st (void)
list	get_use_entities_list (struct gfc_namespace *ns)
gfc_code *	gfc2pips_get_last_loop (void)
void	gfc2pips_push_loop (gfc_code *c)
void	gfc2pips_pop_loop (void)

Variables
list	gfc_module_callees = NULL
	FIXME: should be generated... More...
list	gfc2pips_list_of_declared_code = NULL
list	gfc2pips_list_of_loops = NULL
hash_table	ns2use = NULL
	void gfc2pips_get_use_st( void ); More...

Function Documentation

fcopy()

int fcopy	(	const char *	old,
		const char *	new
	)

copy the file called *old to the file called *new

copy the content of the first file to the second one

Definition at line 143 of file gfc2pips-util.c.

                                            {
  if(!old || !new)
    return 0;
  FILE * o = fopen(old, "r");
  if(o) {
    FILE * n = fopen(new, "w");
    if(n) {
      int c = fgetc(o);
      while(c != EOF) {
        fputc(c, n);
        c = fgetc(o);
      }
      fclose(n);
      fclose(o);
      return 1;
    }
    fclose(o);
    return 0;
  }
  return 0;
}

Referenced by gfc2pips_namespace().

Here is the caller graph for this function:

gen_union()

list gen_union	(	list	a,
		list	b
	)

generate an union of unique elements taken from A and B

Definition at line 47 of file gfc2pips-util.c.

                               {
  list c = NULL;
  while(a) {
    if(!gen_in_list_p(CHUNK( CAR( a ) ), c))
      c = gen_cons(CHUNK( CAR( a ) ), c);
    POP( a );
  }
  while(b) {
    if(!gen_in_list_p(CHUNK( CAR( b ) ), c))
      c = gen_cons(CHUNK( CAR( b ) ), c);
    POP( b );
  }
  return c;
}

References CAR, CHUNK, gen_cons(), gen_in_list_p(), and POP.

Referenced by gfc2pips_namespace().

Here is the call graph for this function:

Here is the caller graph for this function:

get_use_entities_list()

list get_use_entities_list

(

struct gfc_namespace *

ns

)

Create an entity

Definition at line 316 of file gfc2pips-util.c.

                                                     {
  list use_entities = NULL;
  if(ns2use) {
    int currentUse = 1;
    list use_stmts = NULL; // List of entities
    if((use_stmts = hash_get(ns2use, (char *)ns)) != HASH_UNDEFINED_VALUE) {
      string use = NULL;
      int current_len = 1;
      FOREACH(string, a_use, use_stmts) {
        int a_len = strlen(a_use);
        current_len += a_len;
        if(use == NULL) {
          use = (string)malloc(current_len * sizeof(char));
        } else {
          use = (string)realloc((void*)use, current_len * sizeof(char));
        }
        strcpy(&(use[current_len - a_len - 1]), a_use);
      }
      /* Create an entity */
      string entity_name;
      asprintf(&entity_name, "%s-use-%d", CurrentPackage, currentUse++);
      entity e = FindOrCreateEntity(F95_USE_LOCAL_NAME, use);
      entity_type(e) = make_type_unknown();
      entity_storage(e) = make_storage_rom();
      entity_initial(e) = make_value_unknown();
      use_entities = CONS(ENTITY,e,use_entities);
    }
  }
  return use_entities;
}

References asprintf, CONS, CurrentPackage, ENTITY, entity_initial, entity_name, entity_storage, entity_type, F95_USE_LOCAL_NAME, FindOrCreateEntity(), FOREACH, hash_get(), HASH_UNDEFINED_VALUE, make_storage_rom(), make_type_unknown(), make_value_unknown(), malloc(), and ns2use.

Referenced by gfc2pips_namespace().

Here is the call graph for this function:

Here is the caller graph for this function:

gfc2pips_add_to_callees()

void gfc2pips_add_to_callees

(

entity

e

)

Add an entity to the list of callees.

Definition at line 67 of file gfc2pips-util.c.

                                       {
 
  if(!intrinsic_entity_p(e) && strcmp_(entity_local_name(e), CurrentPackage)
      != 0) {
    gfc2pips_debug(5, "Add callee : %s\n", entity_local_name( e ) );
    gfc_module_callees = CONS(string,entity_local_name(e),gfc_module_callees);
  }
}

References CONS, CurrentPackage, entity_local_name(), gfc2pips_debug, gfc_module_callees, intrinsic_entity_p(), and strcmp_().

Referenced by gfc2pips_code2instruction_(), and gfc2pips_get_extern_entities().

Here is the call graph for this function:

Here is the caller graph for this function:

gfc2pips_get_last_loop()

gfc_code* gfc2pips_get_last_loop

(

void

)

Definition at line 348 of file gfc2pips-util.c.

                                       {
  if(gfc2pips_list_of_loops)
    return gfc2pips_list_of_loops->car.e;
  return NULL;
}

References cons::car, gen_chunk::e, and gfc2pips_list_of_loops.

Referenced by gfc2pips_code2instruction(), and gfc2pips_code2instruction_().

Here is the caller graph for this function:

gfc2pips_get_use_st()

void gfc2pips_get_use_st

(

void

)

Definition at line 278 of file gfc2pips-util.c.

                               {
 
  char c;
  string use = "USE";
  int len = strlen(use);
 
  gfc_char_t *p = gfc_current_locus.nextc;
  // Fixme : p == NULL
  while(!(char)*p == '\0')
    p++;
  char use_stmt[len + (p - gfc_current_locus.nextc) + 2];
 
  strcpy(use_stmt, use);
  p = gfc_current_locus.nextc;
  int pos = len;
  do {
    if(p == NULL) {
      c = '\0';
    } else {
      c = *p++;
    }
 
    use_stmt[pos++] = c;
  } while(c != '\0');
  if(ns2use == NULL) {
    ns2use = hash_table_make(hash_pointer, 0);
  }
  list use_stmts;
  if((use_stmts = hash_get(ns2use, (char *)gfc_current_ns))
      == HASH_UNDEFINED_VALUE) {
    use_stmts = CONS(string, strdup(use_stmt), NIL );
    hash_put(ns2use, (char *)gfc_current_ns, (char *)use_stmts);
  } else {
    CONS(string, strdup(use_stmt), use_stmts );
  }
 
}

References CONS, hash_get(), hash_pointer, hash_put(), hash_table_make(), HASH_UNDEFINED_VALUE, NIL, ns2use, and strdup().

Here is the call graph for this function:

gfc2pips_pop_loop()

void gfc2pips_pop_loop

(

void

)

Definition at line 356 of file gfc2pips-util.c.

                             {
  POP( gfc2pips_list_of_loops );
}

References gfc2pips_list_of_loops, and POP.

Referenced by gfc2pips_code2instruction_().

Here is the caller graph for this function:

gfc2pips_push_loop()

void gfc2pips_push_loop

(

gfc_code *

c

)

Definition at line 353 of file gfc2pips-util.c.

                                     {
  gfc2pips_list_of_loops = gen_cons(c, gfc2pips_list_of_loops);
}

References gen_cons(), and gfc2pips_list_of_loops.

Referenced by gfc2pips_code2instruction_().

Here is the call graph for this function:

Here is the caller graph for this function:

gfc2pips_truncate_useless_zeroes()

void gfc2pips_truncate_useless_zeroes

(

char *

s

)

expurgates a string representing a REAL, could be a pre-prettyprinter processing

1.0000000000e+00 becomes 1. 1234.5670000e+18 becomes 1234.567e+18

f(*s=='.'){ s='\0'; s–; gfc2pips_debug(9,"final dot retrieved\n"); }

Definition at line 172 of file gfc2pips-util.c.

                                               {
  char *start = s;
  bool has_dot = false;
  char *end_sci = NULL;//scientific output ?
  while(*s) {
    if(*s == '.') {
      has_dot = true;
      gfc2pips_debug(9,"found [dot] at %lu\n",s-start);
      s++;
      while(*s) {
        if(*s == 'e') {
          end_sci = s;
          break;
        }
        s++;
      }
      break;
    }
    s++;
  }
  if(has_dot) {
    int nb = 0;
    if(end_sci) {
      s = end_sci - 1;
    } else {
      s = start + strlen(start);
    }
 
    while(s > start) {
      if(*s == '0') {
        *s = '\0';
        nb++;
      } else {
        break;
      }
      s--;
    }
    gfc2pips_debug(9,"%d zero(s) retrieved\n", nb);
    /*if(*s=='.'){
     *s='\0';
     s--;
     gfc2pips_debug(9,"final dot retrieved\n");
     }*/
    if(end_sci) {
      if(strcmp(end_sci, "e+00") == 0) {
        *(s + 1) = '\0';
      } else if(s != end_sci - 1) {
        strcpy(s + 1, end_sci);
      }
    }
  }
}

References gfc2pips_debug, and start.

Referenced by gfc2pips_real2entity().

Here is the caller graph for this function:

load_entities()

void load_entities

(

)

Definition at line 225 of file gfc2pips-util.c.

                     {
  FILE *entities =
      (FILE *)safe_fopen((char *)gfc_option.gfc2pips_entities, "r");
  int read = gen_read_tabulated(entities, FALSE);
  safe_fclose(entities, (char *)gfc_option.gfc2pips_entities);
  pips_assert("entities were read", read==entity_domain);
}

References entity_domain, gen_read_tabulated(), gfc_option, pips_assert, safe_fclose(), and safe_fopen().

Referenced by pips_init().

Here is the call graph for this function:

Here is the caller graph for this function:

pips_init()

void pips_init

(

)

get NewGen data type description

Definition at line 240 of file gfc2pips-util.c.

                 {
 
  static int initialized = FALSE;
 
  if (!initialized)
  {
    // FIXME:
    set_pips_meta_informations("<unknown>", "<unknown>", "<unknown>");
 
    /* get NewGen data type description */
    //  gen_read_spec(ALL_SPECS);
    gen_read_spec(ri_spec,
                  text_spec,
                  c_parser_private_spec,
                  parser_private_spec,
                  (char*)NULL);
 
    gen_init_external(PVECTEUR_NEWGEN_EXTERNAL,
                      (void* (*)())vect_gen_read,
                      (void(*)())vect_gen_write,
                      (void(*)())vect_gen_free,
                      (void* (*)())vect_gen_copy_tree,
                      (int(*)())vect_gen_allocated_memory);
 
    // Pips init
    load_entities();
 
    initialized = TRUE;
  }
}

References c_parser_private_spec, gen_init_external(), gen_read_spec(), load_entities(), parser_private_spec, PVECTEUR_NEWGEN_EXTERNAL, ri_spec, set_pips_meta_informations(), text_spec, vect_gen_allocated_memory(), vect_gen_copy_tree(), vect_gen_free(), vect_gen_read(), and vect_gen_write().

Referenced by gfc2pips_namespace().

Here is the call graph for this function:

Here is the caller graph for this function:

save_entities()

void save_entities

(

)

Definition at line 233 of file gfc2pips-util.c.

                     {
  FILE *entities =
      (FILE *)safe_fopen((char *)gfc_option.gfc2pips_entities, "w");
  gen_write_tabulated(entities, entity_domain);
  safe_fclose(entities, (char *)gfc_option.gfc2pips_entities);
}

References entity_domain, gen_write_tabulated(), gfc_option, safe_fclose(), and safe_fopen().

Referenced by gfc2pips_namespace().

Here is the call graph for this function:

Here is the caller graph for this function:

str2upper()

char* str2upper

(

char

s[]

)

Here are few utility functions to handle splitted files and do comparisons with case insensitive.

put the given char table to upper case

replace lower case char by upper case ones

Definition at line 83 of file gfc2pips-util.c.

                           {
 
  // FIXME Disabled !!!
  //  return s;
 
  int n = 0;
  if(s && s[n] != '\0') {
    do {
      s[n] = toupper(s[n]);
      n++;
    } while(s[n] != '\0');
  }
  return s;
}

Referenced by gfc2pips_char2entity(), gfc2pips_check_entity_block_data_exists(), gfc2pips_check_entity_doesnt_exists(), gfc2pips_check_entity_exists(), gfc2pips_check_entity_module_exists(), gfc2pips_check_entity_program_exists(), gfc2pips_expr2entity(), gfc2pips_expr2expression(), gfc2pips_getbasic(), gfc2pips_symbol2entity(), gfc2pips_symbol2top_entity(), gfc2pips_vars_(), strcmp_(), and strncmp_().

Here is the caller graph for this function:

strcmp_()

int strcmp_	(	__const char *	__s1,
		__const char *	__s2
	)

insensitive case comparison

compare the strings in upper case mode

Definition at line 119 of file gfc2pips-util.c.

                                                    {
  char *a = str2upper(strdup(__s1));
  char *b = str2upper(strdup(__s2));
  int ret = strcmp(a, b);
  free(a);
  free(b);
  return ret;
}

References free(), ret, str2upper(), and strdup().

Referenced by __attribute__(), gfc2pips_add_to_callees(), and gfc2pips_namespace().

Here is the call graph for this function:

Here is the caller graph for this function:

strn2upper()

char* strn2upper	(	char	s[],
		size_t	n
	)

replace lower case char by upper case ones

put the n first elements of the given char table to upper case

Definition at line 100 of file gfc2pips-util.c.

                                      {
  while(n) {
    s[n - 1] = toupper(s[n - 1]);
    n--;
  }
  return s;
}

strncmp_()

int strncmp_	(	__const char *	__s1,
		__const char *	__s2,
		size_t	__n
	)

insensitive case n-comparison

compare the strings in upper case mode

Definition at line 131 of file gfc2pips-util.c.

                                                                 {
  char *a = str2upper(strdup(__s1));
  char *b = str2upper(strdup(__s2));
  int ret = strncmp(a, b, __n);
  free(a);
  free(b);
  return ret;
}

References free(), ret, str2upper(), and strdup().

Referenced by gfc2pips_get_safe_name().

Here is the call graph for this function:

Here is the caller graph for this function:

strrcpy()

char* strrcpy	(	char *	dest,
		__const char *	src
	)

copy a string from the last char (to allow copy on itself)

same as strcpy, but begin by the end of the string allowing you to give twice the same string

Definition at line 110 of file gfc2pips-util.c.

                                              {
  int i = strlen(src);
  while(i--)
    dest[i] = src[i];
  return dest;
}

References src.

Referenced by gfc2pips_push_comment().

Here is the caller graph for this function:

Variable Documentation

gfc2pips_list_of_declared_code

list gfc2pips_list_of_declared_code = NULL

Definition at line 41 of file gfc2pips-util.c.

Referenced by gfc2pips_code2instruction__TOP(), gfc2pips_push_last_code(), and gfc2pips_shift_comments().

gfc2pips_list_of_loops

list gfc2pips_list_of_loops = NULL

Definition at line 42 of file gfc2pips-util.c.

Referenced by gfc2pips_get_last_loop(), gfc2pips_pop_loop(), and gfc2pips_push_loop().

gfc_module_callees

list gfc_module_callees = NULL

FIXME: should be generated...

Store the list of callees.

Definition at line 40 of file gfc2pips-util.c.

Referenced by gfc2pips_add_to_callees(), and gfc2pips_namespace().

ns2use

hash_table ns2use = NULL

void gfc2pips_get_use_st( void );

This function is called by the GFC parser when encountering a USE statement. It'll produce an entry in "ns2use" hashtable

Definition at line 277 of file gfc2pips-util.c.

Referenced by get_use_entities_list(), and gfc2pips_get_use_st().