cprettyprinter.c File Reference

#include <stdio.h>
#include <ctype.h>
#include "genC.h"
#include "linear.h"
#include "properties.h"
#include "misc.h"
#include "pipsdbm.h"
#include "ri.h"
#include "effects.h"
#include "ri-util.h"
#include "prettyprint.h"
#include "effects-util.h"
#include "text-util.h"

Include dependency graph for cprettyprinter.c:

Go to the source code of this file.

Data Structures
struct	s_ppt
struct	c_full_name

Macros
#define	EMPTY   ""
#define	NL   "\n"
#define	SEMICOLON   ";" NL
#define	SPACE   " "
#define	OPENBRACKET   "["
#define	CLOSEBRACKET   "]"
#define	OPENPAREN   "("
#define	CLOSEPAREN   ")"
#define	OPENBRACE   "{"
#define	CLOSEBRACE   "}"
#define	SHARPDEF   "#define"
#define	COMMENT   "//" SPACE
#define	INDENT   "indent"
#define	CROUGH   ".crough"
#define	CPRETTY   ".c"
#define	INTERFACE   "_interface.f08"
#define	SCALAR_IN_SIG_EXT   "_p4a_copy"
#define	MAX_FCT   "crough_max"
#define	MIN_FCT   "crough_min"
#define	MAX_DEF   "#define " MAX_FCT "(a,b) (((a)>(b))?(a):(b))\n"
#define	MIN_DEF   "#define " MIN_FCT "(a,b) (((a)<(b))?(a):(b))\n"
#define	POW_PRE   "crough_"
#define	POW_DEF   "#define " POW_PRE "powi(a,b) ((a)^(b))\n"
#define	CMPLX_FCT   "init_complex"
#define	CMPLX_DEF   "#define " CMPLX_FCT "(a,b) (a + b*I)\n"
#define	current_module_is_a_function()    (entity_function_p(get_current_module_entity()))
#define	RESULT_NAME   "result"
#define	MAIN_DECLARATION   "int main(int argc, char *argv[])" NL
	returns the head of the function/subroutine/program. More...
#define	RET   "return"
#define	CONT   "continue"

Typedefs
typedef string(*	prettyprinter) (const char *, list)
	generate a basic c expression. More...

Functions
static string	c_expression (expression, bool)
	forward declaration. More...
static bool	convert_double_value (char **str)
	test if the string looks like a REAL*8 (double in C) declaration i.e something like 987987D54654 : a bunch of digit with a letter in the middle. More...
static void	const_wrapper (char **s)
static char *	c_entity_local_name (entity var)
static void	build_written_list (list l)
static bool	written_p (entity e)
static string	scalar_prelude ()
static string	scalar_postlude ()
static bool	scalar_by_pointer (entity var)
	we want to decide if a scalar variable need to be passed by pointer or by value to a C function. More...
static string	c_basic_string (basic b)
static string	c_type_string (type t)
static string	c_dim_string (list ldim, bool fct_sig)
static string	c_qualifier_string (list l)
static string	c_brace_expression_string (expression exp)
static string	this_entity_cdeclaration (entity var, bool fct_sig)
static bool	parameter_p (entity e)
static bool	variable_p (entity e)
static bool	parameter_or_variable_p (entity e)
static bool	argument_p (entity e)
static string	c_declarations (entity module, bool(*consider_this_entity)(entity), string separator, bool lastsep, bool fct_sig)
static string	c_include (void)
static string	c_macro (void)
static string	c_head (entity module)
static bool	expression_needs_parenthesis_p (expression)
static string	ppt_binary (const char *in_c, list le)
static string	ppt_unary (const char *in_c, list le)
static string	ppt_unary_post (const char *in_c, list le)
static string	ppt_call (const char *in_c, list le)
	SG: PBM spotted HERE. More...
static void	get_c_full_name (string *base_in_c, basic b)
	fill the c_base_name to get the c full name accorgind to its basic More...
static string	ppt_math (const char *in_c, list le)
static string	ppt_min_max (const char *in_c, list le)
static string	ppt_unknown (const char *in_f, list le)
static string	ppt_must_error (const char *in_f, _UNUSED_ list le)
static struct s_ppt *	get_ppt (entity f)
	return the prettyprinter structure for c. More...
static string	c_call (call c, bool breakable)
static string	c_reference (reference r)
	Attention with Fortran: the indexes are reversed. More...
static string	c_statement (statement s, bool breakable)
static string	c_unstructured (unstructured u, bool breakable)
static string	c_test (test t, bool breakable)
static string	c_sequence (sequence seq, bool breakable)
static string	c_loop (loop l)
static string	c_whileloop (whileloop w)
static string	c_forloop (forloop f)
static string	interface_type_string (type t, bool value)
static string	interface_basic_string (basic b, bool value)
	Convert the fortran basic to its interface string value. More...
static string	interface_argument_type_string (entity var)
	return a string representation of the type to be used for a variable decalaration in an interface module in order to ensure that the C function can be called from fotran codes More...
static string	interface_argument_declaration (entity module, string separator, string indent)
static string	interface_signature (entity module)
	return the interface signature for a module, i.e. More...
static string	interface_code_string (entity module, _UNUSED_ statement stat)
static string	c_code_string (entity module, statement stat)
bool	print_interface (const char *module_name)
	cprettyprinter.c More...
bool	print_crough (const char *module_name)
bool	print_c_code (const char *module_name)
	C indentation thru indent. More...

Variables
static list	l_type = NIL
static list	l_name = NIL
static list	l_rename = NIL
static list	l_entity = NIL
static list	l_written = NIL
static c_full_name	c_base_name_to_c_full_name []
static struct s_ppt	intrinsic_to_c []

Macro Definition Documentation

CLOSEBRACE

#define CLOSEBRACE   "}"

Definition at line 74 of file cprettyprinter.c.

CLOSEBRACKET

#define CLOSEBRACKET   "]"

Definition at line 68 of file cprettyprinter.c.

CLOSEPAREN

#define CLOSEPAREN   ")"

Definition at line 71 of file cprettyprinter.c.

CMPLX_DEF

#define CMPLX_DEF   "#define " CMPLX_FCT "(a,b) (a + b*I)\n"

Definition at line 96 of file cprettyprinter.c.

CMPLX_FCT

#define CMPLX_FCT   "init_complex"

Definition at line 95 of file cprettyprinter.c.

COMMENT

#define COMMENT   "//" SPACE

Definition at line 77 of file cprettyprinter.c.

CONT

#define CONT   "continue"

Definition at line 1399 of file cprettyprinter.c.

CPRETTY

#define CPRETTY   ".c"

Definition at line 82 of file cprettyprinter.c.

CROUGH

#define CROUGH   ".crough"

Definition at line 81 of file cprettyprinter.c.

current_module_is_a_function

#define current_module_is_a_function

(

)

(entity_function_p(get_current_module_entity()))

Definition at line 112 of file cprettyprinter.c.

EMPTY

#define EMPTY   ""

Definition at line 62 of file cprettyprinter.c.

INDENT

#define INDENT   "indent"

Definition at line 80 of file cprettyprinter.c.

INTERFACE

#define INTERFACE   "_interface.f08"

Definition at line 83 of file cprettyprinter.c.

MAIN_DECLARATION

#define MAIN_DECLARATION   "int main(int argc, char *argv[])" NL

returns the head of the function/subroutine/program.

declarations look ANSI C.

Definition at line 903 of file cprettyprinter.c.

MAX_DEF

#define MAX_DEF   "#define " MAX_FCT "(a,b) (((a)>(b))?(a):(b))\n"

Definition at line 91 of file cprettyprinter.c.

MAX_FCT

#define MAX_FCT   "crough_max"

Definition at line 89 of file cprettyprinter.c.

MIN_DEF

#define MIN_DEF   "#define " MIN_FCT "(a,b) (((a)<(b))?(a):(b))\n"

Definition at line 92 of file cprettyprinter.c.

MIN_FCT

#define MIN_FCT   "crough_min"

Definition at line 90 of file cprettyprinter.c.

NL

#define NL   "\n"

Definition at line 63 of file cprettyprinter.c.

OPENBRACE

#define OPENBRACE   "{"

Definition at line 73 of file cprettyprinter.c.

OPENBRACKET

#define OPENBRACKET   "["

Definition at line 67 of file cprettyprinter.c.

OPENPAREN

#define OPENPAREN   "("

Definition at line 70 of file cprettyprinter.c.

POW_DEF

#define POW_DEF   "#define " POW_PRE "powi(a,b) ((a)^(b))\n"

Definition at line 94 of file cprettyprinter.c.

POW_PRE

#define POW_PRE   "crough_"

Definition at line 93 of file cprettyprinter.c.

RESULT_NAME

#define RESULT_NAME   "result"

Definition at line 116 of file cprettyprinter.c.

RET

#define RET   "return"

Definition at line 1398 of file cprettyprinter.c.

SCALAR_IN_SIG_EXT

#define SCALAR_IN_SIG_EXT   "_p4a_copy"

Definition at line 86 of file cprettyprinter.c.

SEMICOLON

#define SEMICOLON   ";" NL

Definition at line 64 of file cprettyprinter.c.

SHARPDEF

#define SHARPDEF   "#define"

Definition at line 76 of file cprettyprinter.c.

SPACE

#define SPACE   " "

Definition at line 65 of file cprettyprinter.c.

Typedef Documentation

prettyprinter

typedef string(* prettyprinter) (const char *, list)

generate a basic c expression.

no operator priority is assumed...

Definition at line 967 of file cprettyprinter.c.

Function Documentation

argument_p()

static bool argument_p ( entity  e )

static

Returns

true if the entity is an argument

Formal variables

Definition at line 792 of file cprettyprinter.c.

{
    /* Formal variables */
    return type_variable_p(entity_type(e)) &&
        storage_formal_p(entity_storage(e));
}

References entity_storage, entity_type, storage_formal_p, and type_variable_p.

Referenced by c_head(), interface_argument_declaration(), interface_argument_type_string(), and interface_signature().

Here is the caller graph for this function:

build_written_list()

static void build_written_list ( list  l )

static

Definition at line 211 of file cprettyprinter.c.

                                        {
  list l_effects = l;
  FOREACH (EFFECT, eff,  l_effects) {
    if (effect_write_p (eff)) {
      entity e = effect_any_entity (eff);
      l_written = gen_entity_cons(e, l_written);
      pips_debug (5, "entity %s (%p) is written\n", entity_local_name (e), e);
    } else {
      entity e = effect_any_entity (eff);
      pips_debug (5, "entity %s (%p) is not written\n", entity_local_name (e), e);
    }
  }
}

References EFFECT, effect_any_entity, effect_write_p, entity_local_name(), FOREACH, gen_entity_cons(), l_written, and pips_debug.

Referenced by print_crough().

Here is the call graph for this function:

Here is the caller graph for this function:

c_basic_string()

static string c_basic_string ( basic  b )

static

An expression indeed... To be fixed...

ignore if it is signed or unsigned

c99 style with include of complex.h

Definition at line 345 of file cprettyprinter.c.

{
  const char* result = "UNKNOWN_BASIC" SPACE;
  char * aresult=NULL;
  bool user_type = get_bool_property ("CROUGH_USER_DEFINED_TYPE");
  switch (basic_tag(b)) {
  case is_basic_int: {
    pips_debug(2,"Basic int\n");
    if (user_type == false) {
      switch (basic_int(b)) {
      case 1: result = "char" SPACE;
        break;
      case 2: result = "short" SPACE;
        break;
      case 4: result = "int" SPACE;
        break;
      case 6: result = "long" SPACE;
        break;
      case 8: result = "long long" SPACE;
        break;
      case 11: result = "unsigned char" SPACE;
        break;
      case 12: result = "unsigned short" SPACE;
        break;
      case 14: result = "unsigned int" SPACE;
        break;
      case 16: result = "unsigned long" SPACE;
        break;
      case 18: result = "unsigned long long" SPACE;
        break;
      case 21: result = "signed char" SPACE;
        break;
      case 22: result = "signed short" SPACE;
        break;
      case 24: result = "signed int" SPACE;
        break;
      case 26: result = "signed long" SPACE;
        break;
      case 28: result = "signed long long" SPACE;
        break;
      }
    } else {
      result = get_string_property ("CROUGH_INTEGER_TYPE");
    }
    break;
  }
  case is_basic_float: {
    if (user_type == false) {
      switch (basic_float(b)){
      case 4: result = "float" SPACE;
        break;
      case 8: result = "double" SPACE;
        break;
      }
    } else {
      result = get_string_property ("CROUGH_REAL_TYPE");
    }
    break;
  }
  case is_basic_logical:
    result = "int" SPACE;
    break;
  case is_basic_string:
    result = "char" SPACE;
    break;
  case is_basic_bit:
    {
      /* An expression indeed... To be fixed... */
      _int i = (_int) basic_bit(b);
      pips_debug(2,"Bit field basic: %td\n", i);
      result = "int" SPACE; /* ignore if it is signed or unsigned */
      break;
    }
  case is_basic_pointer:
    {
      type t = basic_pointer(b);
      pips_debug(2,"Basic pointer\n");
      result = concatenate(c_type_string(t),"* ",NULL);
      break;
    }
  case is_basic_derived:
    {
      entity ent = basic_derived(b);
      type t = entity_type(ent);
      char* name = c_entity_local_name(ent);
      result = concatenate(c_type_string(t),name,NULL);
      free(name);
      break;
    }
  case is_basic_typedef:
    {
      entity ent = basic_typedef(b);
      aresult = c_entity_local_name(ent);
      break;
    }
  case is_basic_complex:
    result = "complex" SPACE; /* c99 style with include of complex.h*/
    break;
  default:
    pips_internal_error("unhandled case");
  }
  return aresult ? aresult : strdup(result);
}

References basic_bit, basic_derived, basic_float, basic_int, basic_pointer, basic_tag, basic_typedef, c_entity_local_name(), c_type_string(), concatenate(), entity_type, free(), get_bool_property(), get_string_property(), is_basic_bit, is_basic_complex, is_basic_derived, is_basic_float, is_basic_int, is_basic_logical, is_basic_pointer, is_basic_string, is_basic_typedef, pips_debug, pips_internal_error, SPACE, and strdup().

Referenced by c_head(), c_type_string(), and this_entity_cdeclaration().

Here is the call graph for this function:

Here is the caller graph for this function:

c_brace_expression_string()

static string c_brace_expression_string ( expression  exp )

static

Definition at line 556 of file cprettyprinter.c.

{
    string result = "{";
    list args = call_arguments(syntax_call(expression_syntax(exp)));
 
    bool first = true;
    FOREACH (EXPRESSION,e,args)
    {
        if (brace_expression_p(e))
            result = strdup(concatenate(result,first?"":",",
                                        c_brace_expression_string(e),NULL));
        else
          result = strdup(concatenate(result,first?"":",",
                                      expression_to_string(e),NULL));
        first = false;
    }
    result = strdup(concatenate(result,"}",NULL));
    return result;
}

References brace_expression_p(), call_arguments, concatenate(), exp, EXPRESSION, expression_syntax, expression_to_string(), FOREACH, strdup(), and syntax_call.

Referenced by this_entity_cdeclaration().

Here is the call graph for this function:

Here is the caller graph for this function:

c_call()

static string c_call ( call  c, bool  breakable  )

static

special case...

Definition at line 1401 of file cprettyprinter.c.

{
    entity called = call_function(c);
    struct s_ppt * ppt = get_ppt(called);
    char* local_name = strdup(entity_local_name(called));
    string result = NULL;
 
    /* special case... */
    if (same_string_p(local_name, "RETURN")) {
      string copy_out = scalar_postlude ();
      if (entity_main_module_p(get_current_module_entity()))
        result = RET " 0";
      else if (current_module_is_a_function())
        result = RET SPACE RESULT_NAME;
      else
        result = RET;
      result = strdup(concatenate (copy_out, result, NULL));
      free (copy_out);
    }
    else if (same_string_p(local_name, "CONTINUE") )
    {
        result = breakable?strdup(CONT):strdup("");
    }
    else if (call_constant_p(c))
    {
        const_wrapper(&local_name);
        result = strlower(strdup(local_name),local_name);
    }
    else
    {
        result = ppt->ppt(ppt->c? ppt->c: local_name, call_arguments(c));
        string tmp = result;
        result=strlower(strdup(result),result);
        free(tmp);
    }
    //free(local_name);
 
    return result;
}

References s_ppt::c, call_arguments, call_constant_p, call_function, concatenate(), const_wrapper(), CONT, current_module_is_a_function, entity_local_name(), entity_main_module_p(), free(), get_current_module_entity(), get_ppt(), local_name(), s_ppt::ppt, RESULT_NAME, RET, same_string_p, scalar_postlude(), SPACE, strdup(), and strlower().

Referenced by c_expression(), and c_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

c_code_string()

static string c_code_string ( entity  module, statement  stat  )

static

What about declarations that are external a module scope ? Consider a source file as a module entity, put all declarations in it (external static + TOP-LEVEL)

before_head only generates the constant declarations, such as #define

Definition at line 2108 of file cprettyprinter.c.

{
  string head, decls, body, result, copy_in, include, macro;
 
  /* What about declarations that are external a module scope ?
     Consider a source file as a module entity, put all declarations in it
     (external static + TOP-LEVEL) */
 
  /* before_head only generates the constant declarations, such as #define*/
  ifdebug(2)
    {
      printf("Module statement: \n");
      print_statement(stat);
      printf("and declarations: \n");
      print_entities(statement_declarations(stat));
    }
 
  // get the needed includes
  include     = c_include ();
  // get the needed macro
  macro       = c_macro ();
  // function declaration
  head        = c_head(module);
  // What about declarations associated to statements
  decls       = c_declarations(module,parameter_or_variable_p,SEMICOLON,true,
                                                           false);
  body        = c_statement(stat, false);
  copy_in     = scalar_prelude ();
 
  // concatenate everything to get the code
  result = concatenate(include, macro, head, OPENBRACE, NL, decls,
                                           copy_in, NL, body, CLOSEBRACE, NL, NULL);
 
  free (include);
  free(head);
  free(decls);
  free(body);
  free(copy_in);
  return strdup(result);
}

References c_declarations(), c_head(), c_include(), c_macro(), c_statement(), CLOSEBRACE, concatenate(), free(), ifdebug, include(), module, NL, OPENBRACE, parameter_or_variable_p(), print_entities(), print_statement(), printf(), scalar_prelude(), SEMICOLON, statement_declarations, and strdup().

Referenced by print_crough().

Here is the call graph for this function:

Here is the caller graph for this function:

c_declarations()

static string c_declarations ( entity  module, bool(*)(entity)  consider_this_entity, string  separator, bool  lastsep, bool  fct_sig  )

static

Returns

the string representation of the given declarations.

Parameters

module,the	module to get the declaration.
consider_this_entity,the	function test pointer.
separator,the	separatot to be used between vars.
lastsep,set	to true if a final separator is needed.
fct_sig,set	to true if in a function signature.

Definition at line 805 of file cprettyprinter.c.

{
    string result = strdup("");
    code c;
    bool first = true;
 
    pips_assert("it is a code", value_code_p(entity_initial(module)));
 
    c = value_code(entity_initial(module));
    FOREACH(ENTITY, var,code_declarations(c))
    {
        string tmp = NULL;
        tmp = c_entity_local_name(var);
        pips_debug(2, "Prettyprinter declaration for variable :%s\n",tmp);
        free(tmp);
        if (consider_this_entity(var))
        {
            string old = result;
            string svar = this_entity_cdeclaration(var, fct_sig);
            pips_debug(6, "svar = %s\n", svar);
            result = strdup(concatenate(old, !first ? separator: "",
                        svar, NULL));
            pips_debug(6, "result = %s\n", result);
            free(svar);
            free(old);
            first = false;
        }
    }
    // insert the last separtor if required and if at least one declaration
    // has been inserted.
    if (lastsep && !first)
      result = strdup(concatenate(result, separator, NULL));
    return result;
}

References c_entity_local_name(), code_declarations, concatenate(), ENTITY, entity_initial, FOREACH, free(), module, pips_assert, pips_debug, strdup(), this_entity_cdeclaration(), value_code, and value_code_p.

Referenced by c_code_string(), and c_head().

Here is the call graph for this function:

Here is the caller graph for this function:

c_dim_string()

static string c_dim_string ( list  ldim, bool  fct_sig  )

static

Returns

a newly allocated string of the dimensions in C

Parameters

ldim	the variable dimension
fct_sig,set	to true if the variable is part of a function signature

In fact, the lower bound of array in C is always equal to 0, we only need to print (upper dimension + 1) but in order to handle Fortran code, we check all other possibilities and print (upper - lower + 1). Problem : the order of dimensions is reversed !!!!

to be refined here to make more beautiful expression

otherwise the list is empty, no dimension to declare

Definition at line 452 of file cprettyprinter.c.

{
    string result = "";
    if (ldim != NIL )
    {
        FOREACH(DIMENSION, dim,ldim)
        {
            expression elow = dimension_lower(dim);
            expression eup = dimension_upper(dim);
            intptr_t low;
            intptr_t up;
            string slow;
            string sup;
 
            /* In fact, the lower bound of array in C is always equal to 0,
               we only need to print (upper dimension + 1)
               but in order to handle Fortran code, we check all other possibilities
               and print (upper - lower + 1). Problem : the order of dimensions is reversed !!!! */
#if 1
            if (expression_integer_value(elow, &low))
            {
                if (low == 0)
                {
                    if (expression_integer_value(eup, &up))
                        result = strdup(concatenate(OPENBRACKET,int2a(up+1),CLOSEBRACKET,result,NULL));
                    else
                        /* to be refined here to make more beautiful expression */
                        result = strdup(concatenate(OPENBRACKET,
                                    expression_to_string(MakeBinaryCall(CreateIntrinsic("+"),
                                                                        eup,int_to_expression(1))
                                                         ),
                                    CLOSEBRACKET,result,NULL));
                }
                else
                {
                  if (expression_integer_value(eup, &up)) {
                    result = strdup(concatenate(OPENBRACKET,int2a(up-low+1),CLOSEBRACKET,result,NULL));
                  } else {
                    sup = expression_to_string(eup);
                    if (fct_sig == true) {
                      string tmp = NULL;
                      if (get_bool_property ("CROUGH_FORTRAN_USES_INTERFACE") == false) {
                        tmp = strdup (concatenate ("(*",sup, SCALAR_IN_SIG_EXT, ")", NULL));
                        free (sup);
                        sup = tmp;
                      }
                    }
                    result = strdup(concatenate(OPENBRACKET,sup,"-",int2a(low-1),CLOSEBRACKET,result,NULL));
                    free(sup);
                  }
                }
            }
            else
#endif
            {
                slow = c_expression(elow,false);
                sup = c_expression(eup,false);
                result = strdup(concatenate(OPENBRACKET,sup,"-",slow,"+ 1",CLOSEBRACKET,result,NULL));
                free(slow);
                free(sup);
            }
        }
    }
    /* otherwise the list is empty, no dimension to declare */
    return strlower (strdup (result), result);
}

References c_expression(), CLOSEBRACKET, concatenate(), CreateIntrinsic(), DIMENSION, dimension_lower, dimension_upper, expression_integer_value(), expression_to_string(), FOREACH, free(), get_bool_property(), int2a(), int_to_expression(), intptr_t, MakeBinaryCall(), NIL, OPENBRACKET, SCALAR_IN_SIG_EXT, strdup(), and strlower().

Referenced by this_entity_cdeclaration().

Here is the call graph for this function:

Here is the caller graph for this function:

c_entity_local_name()

static char* c_entity_local_name ( entity  var )

static

Delete all the prefixes

switch to lower cases...

Definition at line 176 of file cprettyprinter.c.

{
    const char* name;
 
    if (current_module_is_a_function() &&
            var != get_current_module_entity() &&
            same_string_p(entity_local_name(var), entity_local_name(get_current_module_entity()))
       )
        name = RESULT_NAME;
    else
    {
        name = entity_local_name(var);
 
        /* Delete all the prefixes */
 
        if (strstr(name,STRUCT_PREFIX) != NULL)
            name = strstr(name,STRUCT_PREFIX) + 1;
        if (strstr(name,UNION_PREFIX) != NULL)
            name = strstr(name,UNION_PREFIX) + 1;
        if (strstr(name,ENUM_PREFIX) != NULL)
            name = strstr(name,ENUM_PREFIX) + 1;
        if (strstr(name,TYPEDEF_PREFIX) != NULL)
            name = strstr(name,TYPEDEF_PREFIX) + 1;
        if (strstr(name,MEMBER_SEP_STRING) != NULL)
            name = strstr(name,MEMBER_SEP_STRING) + 1;
 
        /* switch to lower cases... */
 
    }
    char *rname=strlower(strdup(name),name);
        pips_debug (5, "local name %s found\n", rname);
    return rname;
}

References current_module_is_a_function, entity_local_name(), ENUM_PREFIX, get_current_module_entity(), MEMBER_SEP_STRING, pips_debug, RESULT_NAME, same_string_p, strdup(), strlower(), STRUCT_PREFIX, TYPEDEF_PREFIX, and UNION_PREFIX.

Referenced by c_basic_string(), c_declarations(), c_head(), c_loop(), c_reference(), c_statement(), interface_argument_declaration(), interface_code_string(), interface_signature(), and this_entity_cdeclaration().

Here is the call graph for this function:

Here is the caller graph for this function:

c_expression()

static string c_expression ( expression  e, bool  breakable  )

static

forward declaration.

add cast, sizeof here

Definition at line 1486 of file cprettyprinter.c.

{
    string result = NULL;
    syntax s = expression_syntax(e);
    switch (syntax_tag(s))
    {
        case is_syntax_call:
            result = c_call(syntax_call(s),breakable);
            break;
        case is_syntax_range:
            result = strdup("range not implemented");
            break;
        case is_syntax_reference:
            result = c_reference(syntax_reference(s));
            break;
            /* add cast, sizeof here */
        default:
            pips_internal_error("unexpected syntax tag");
    }
    return result;
}

References c_call(), c_reference(), expression_syntax, is_syntax_call, is_syntax_range, is_syntax_reference, pips_internal_error, strdup(), syntax_call, syntax_reference, and syntax_tag.

Referenced by c_dim_string(), c_forloop(), c_loop(), c_reference(), c_test(), c_unstructured(), c_whileloop(), ppt_binary(), ppt_call(), ppt_min_max(), ppt_unary(), and ppt_unary_post().

Here is the call graph for this function:

Here is the caller graph for this function:

c_forloop()

static string c_forloop ( forloop  f )

static

partial implementation...

Definition at line 1762 of file cprettyprinter.c.

{
    /* partial implementation... */
    string result;
    string body = c_statement(forloop_body(f),true);
    string init = c_expression(forloop_initialization(f),true);
    string cond = c_expression(forloop_condition(f),true);
    string inc = c_expression(forloop_increment(f),true);
    result = strdup(concatenate("for (", init, ";",cond,";",inc,") {" NL,
                body, "}" NL, NULL));
 
    free(inc);
    free(cond);
    free(init);
    free(body);
    return result;
}

References c_expression(), c_statement(), concatenate(), f(), forloop_body, forloop_condition, forloop_increment, forloop_initialization, free(), init, NL, and strdup().

Referenced by c_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

c_head()

static string c_head ( entity  module )

static

another kind : "int main(void)" ?

define type head.

define args.

Definition at line 905 of file cprettyprinter.c.

{
    string result;
 
    pips_assert("it is a function", type_functional_p(entity_type(module)));
 
    if (entity_main_module_p(module)) {
            /* another kind : "int main(void)" ?*/
            result = strdup(MAIN_DECLARATION);
    }
    else {
       string head, args, svar;
           functional f = type_functional(entity_type(module));
 
           /* define type head. */
           if (get_bool_property ("DO_RETURN_TYPE_AS_TYPEDEF") == true) {
           head = strdup (get_string_property ("SET_RETURN_TYPE_AS_TYPEDEF_NEW_TYPE"));
           }
           else if (entity_subroutine_p(module)) {
           head = strdup("void");
           }
       else {
                   variable v;
           pips_assert("type of result is a variable",
                                           type_variable_p(functional_result(f)));
           v = type_variable(functional_result(f));
           head = c_basic_string(variable_basic(v));
        }
 
        /* define args. */
        if (functional_parameters(f))
        {
            args = c_declarations(module, argument_p, ", ", false, true);
        }
        else
        {
            args = strdup("void");
        }
 
        svar = c_entity_local_name(module);
        if (get_bool_property("PRETTYPRINT_C_FUNCTION_NAME_WITH_UNDERSCORE"))
 
          result = strdup(concatenate(head, SPACE, svar, "_",
                                      OPENPAREN, args, CLOSEPAREN, NL, NULL));
 
        else
          result = strdup(concatenate(head, SPACE, svar,
                                      OPENPAREN, args, CLOSEPAREN, NL, NULL));
 
        free(svar);
        free(head);
        free(args);
    }
 
    return result;
}

References argument_p(), c_basic_string(), c_declarations(), c_entity_local_name(), CLOSEPAREN, concatenate(), entity_main_module_p(), entity_subroutine_p(), entity_type, f(), free(), functional_parameters, functional_result, get_bool_property(), get_string_property(), MAIN_DECLARATION, module, NL, OPENPAREN, pips_assert, SPACE, strdup(), type_functional, type_functional_p, type_variable, type_variable_p, and variable_basic.

Referenced by c_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

c_include()

static string c_include ( void  )

static

Definition at line 846 of file cprettyprinter.c.

                               {
  string result = NULL;
 
  // add some c include files in order to support fortran intrinsic
  result = strdup (concatenate ("//needed include to compile the C output\n"
                                                                "#include \"math.h\"\n",   // fabs
                                                                "#include \"stdlib.h\"\n", // abs
                                                                "#include \"complex.h\"\n", // abs
                                                                "\n",
                                                                NULL));
 
  // take care of include file required by the user
  const char* user_req = get_string_property ("CROUGH_INCLUDE_FILE_LIST");
  pips_debug (5, "including the user file list %s\n", user_req);
  string match = NULL;
  string tmp = strdup(user_req);
  match = strtok (tmp, " ,");
  while (match != NULL) {
        string old = result;
        pips_debug (7, "including the file %s\n", match);
        result = strdup (concatenate (result, "#include \"", match, "\"\n", NULL));
        match = strtok (NULL, " ,");
        free (old);
  }
  free (match);free(tmp);
 
  // user might use its own type that are define in a specific file
  bool user_type = get_bool_property ("CROUGH_USER_DEFINED_TYPE");
  pips_debug (5, "includind the user define type file %s\n", user_req);
  if (user_type == true) {
        string old = result;
        const char* f_name = get_string_property ("CROUGH_INCLUDE_FILE");
        pips_debug (7, "including the file %s\n", f_name);
        result = strdup (concatenate (result, "#include \"", f_name, "\"\n",
                                                                  NULL));
        free (old);
  }
  pips_debug (5, "include string : %s\n", result);
  return result;
}

References concatenate(), free(), get_bool_property(), get_string_property(), pips_debug, and strdup().

Referenced by c_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

c_loop()

static string c_loop ( loop  l )

static

partial implementation... However, there is not this kind of loop in C

what about step

Definition at line 1711 of file cprettyprinter.c.

{
    /* partial implementation...
       However, there is not this kind of loop in C */
    string result;
    string body = c_statement(loop_body(l),true);
    string index = c_entity_local_name(loop_index(l));
    range r = loop_range(l);
    string low = c_expression(range_lower(r),true);
    string up = c_expression(range_upper(r),true);
    string theincr = c_expression(range_increment(r),true);
    string incr = 0;
    if( strcmp(theincr,"1")==0 )
      incr = strdup("++");
    else
      incr = strdup(concatenate( "+=", theincr , NULL ));
    free(theincr);
   /* what about step*/
    result = strdup(concatenate("for (", index, "=", low, "; ",
                index, "<=", up, "; ",
                index,  incr, ")", SPACE, OPENBRACE, NL,
                body, CLOSEBRACE, NL, NULL));
    free(body);
    free(index);
    free(incr);
    // TODO: There are some allocation bugs in c_expression()
    //free(low);
    //free(up);
    return result;
}

References c_entity_local_name(), c_expression(), c_statement(), CLOSEBRACE, concatenate(), free(), loop_body, loop_index, loop_range, NL, OPENBRACE, range_increment, range_lower, range_upper, SPACE, and strdup().

Referenced by c_statement(), and loop_annotate().

Here is the call graph for this function:

Here is the caller graph for this function:

c_macro()

static string c_macro ( void  )

static

Definition at line 888 of file cprettyprinter.c.

                             {
  string result = NULL;
  // add some macro to support fortran intrinsics
  result = strdup (concatenate ("// The macros to support some fortran intrinsics\n",
                                                                "// and complex declaration\n"
                                                                MAX_DEF, MIN_DEF, POW_DEF, CMPLX_DEF, "\n",
                                                                NULL));
  return result;
}

References CMPLX_DEF, concatenate(), MAX_DEF, MIN_DEF, POW_DEF, and strdup().

Referenced by c_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

c_qualifier_string()

static string c_qualifier_string ( list  l )

static

Definition at line 519 of file cprettyprinter.c.

{
    string result="";
    FOREACH(QUALIFIER,q,l)
    {
        switch (qualifier_tag(q)) {
            case is_qualifier_register:
                result = concatenate(result,"register ",NULL);
                break;
            case is_qualifier_thread:
                result = concatenate(result,"__thread ",NULL);
                break;
            case is_qualifier_const:
                result = concatenate(result,"const ",NULL);
                break;
            case is_qualifier_restrict:
                result = concatenate(result,"restrict ",NULL);
                break;
            case is_qualifier_volatile:
                result = concatenate(result,"volatile ",NULL);
                break;
            case is_qualifier_auto:
                result = concatenate(result,"auto ",NULL);
                break;
            case is_qualifier_asm:
                result = concatenate(result,"__asm(",qualifier_asm(q),") ", NULL);
                break;
            case is_qualifier_static_dimension:
                result = concatenate(result,"static ",NULL);
                break;
        default:
          pips_internal_error("Unknown qualifier tag %d.\n", qualifier_tag(q));
        }
    }
    return strdup(result);
}

References concatenate(), FOREACH, is_qualifier_asm, is_qualifier_auto, is_qualifier_const, is_qualifier_register, is_qualifier_restrict, is_qualifier_static_dimension, is_qualifier_thread, is_qualifier_volatile, pips_internal_error, QUALIFIER, qualifier_asm, qualifier_tag, and strdup().

Referenced by this_entity_cdeclaration().

Here is the call graph for this function:

Here is the caller graph for this function:

c_reference()

static string c_reference ( reference  r )

static

Attention with Fortran: the indexes are reversed.

And array dimensions in C always rank from 0. BC.

Definition at line 1444 of file cprettyprinter.c.

{
    string result = strdup(EMPTY), old, svar;
 
    list l_dim = variable_dimensions(type_variable(ultimate_type(entity_type(reference_variable(r)))));
 
    FOREACH (EXPRESSION, e,reference_indices(r)) {
      expression e_tmp;
      expression e_lower = dimension_lower(DIMENSION(CAR(l_dim)));
      string s;
      intptr_t itmp;
 
      if( !expression_equal_integer_p(e_lower, 0))
        e_tmp =
          MakeBinaryCall(entity_intrinsic(MINUS_OPERATOR_NAME),
                         copy_expression(e),
                         copy_expression(e_lower));
      else
        e_tmp = copy_expression(e);
 
      if(expression_integer_value(e_tmp, &itmp))
        s = int2a(itmp);
      else
        s = c_expression( e_tmp,false);
 
      old = result;
      result = strdup(concatenate(OPENBRACKET, s, CLOSEBRACKET,old, NULL));
      //free(old);
      //free(s);
      free_expression(e_tmp);
      POP(l_dim);
    }
 
 
    old = result;
    svar = c_entity_local_name(reference_variable(r));
    result = strdup(concatenate(svar, old, NULL));
    free(old);
    free(svar);
    return result;
}

References c_entity_local_name(), c_expression(), CAR, CLOSEBRACKET, concatenate(), copy_expression(), DIMENSION, dimension_lower, EMPTY, entity_intrinsic(), entity_type, EXPRESSION, expression_equal_integer_p(), expression_integer_value(), FOREACH, free(), free_expression(), int2a(), intptr_t, MakeBinaryCall(), MINUS_OPERATOR_NAME, OPENBRACKET, POP, reference_indices, reference_variable, strdup(), type_variable, ultimate_type(), and variable_dimensions.

Referenced by c_expression().

Here is the call graph for this function:

Here is the caller graph for this function:

c_sequence()

static string c_sequence ( sequence  seq, bool  breakable  )

static

Definition at line 1697 of file cprettyprinter.c.

{
    string result = strdup(EMPTY);
    FOREACH (STATEMENT, s, sequence_statements(seq))
    {
        string oldresult = result;
        string current = c_statement(s,breakable);
        result = strdup(concatenate(oldresult, current, NULL));
        free(current);
        free(oldresult);
    }
    return result;
}

References c_statement(), concatenate(), current, EMPTY, FOREACH, free(), sequence_statements, STATEMENT, and strdup().

Referenced by c_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

c_statement()

static string c_statement ( statement  s, bool  breakable  )

static

rintf("\nCurrent statement : \n"); print_statement(s);

add switch, forloop break, continue, return instructions here

Definition at line 1781 of file cprettyprinter.c.

{
    string result;
    instruction i = statement_instruction(s);
    list l = statement_declarations(s);
    /*printf("\nCurrent statement : \n");
      print_statement(s);*/
    switch (instruction_tag(i))
    {
        case is_instruction_test:
            {
                test t = instruction_test(i);
                result = c_test(t,breakable);
                break;
            }
        case is_instruction_sequence:
            {
                sequence seq = instruction_sequence(i);
                result = c_sequence(seq,breakable);
                break;
            }
        case is_instruction_loop:
            {
                loop l = instruction_loop(i);
                result = c_loop(l);
                break;
            }
        case is_instruction_whileloop:
            {
                whileloop w = instruction_whileloop(i);
                result = c_whileloop(w);
                break;
            }
        case is_instruction_forloop:
            {
                forloop f = instruction_forloop(i);
                result = c_forloop(f);
                break;
            }
        case is_instruction_call:
            {
                string scall = c_call(instruction_call(i),breakable);
                result = strdup(concatenate(scall, SEMICOLON, NULL));
                break;
            }
        case is_instruction_unstructured:
            {
                unstructured u = instruction_unstructured(i);
                result = c_unstructured(u,breakable);
                break;
            }
        case is_instruction_goto:
            {
                statement g = instruction_goto(i);
                entity el = statement_label(g);
                const char* l = entity_local_name(el) + sizeof(LABEL_PREFIX) -1;
                result = strdup(concatenate("goto ",l, SEMICOLON, NULL));
                break;
            }
            /* add switch, forloop break, continue, return instructions here*/
        default:
            result = strdup(concatenate(COMMENT, " Instruction not implemented" NL, NULL));
            break;
    }
 
    if (!ENDP(l))
    {
        string decl = "";
        MAP(ENTITY, var,
        {
            string svar;
            string tmp = c_entity_local_name(var);
            debug(2, "\n In block declaration for variable :", tmp);
            free(tmp);
            svar = this_entity_cdeclaration(var, false);
            decl = strdup(concatenate(decl, svar, SEMICOLON, NULL));
            free(svar);
        },l);
        result = strdup(concatenate(decl,result,NULL));
    }
 
    return result;
}

References c_call(), c_entity_local_name(), c_forloop(), c_loop(), c_sequence(), c_test(), c_unstructured(), c_whileloop(), COMMENT, concatenate(), debug(), ENDP, ENTITY, entity_local_name(), f(), free(), instruction_call, instruction_forloop, instruction_goto, instruction_loop, instruction_sequence, instruction_tag, instruction_test, instruction_unstructured, instruction_whileloop, is_instruction_call, is_instruction_forloop, is_instruction_goto, is_instruction_loop, is_instruction_sequence, is_instruction_test, is_instruction_unstructured, is_instruction_whileloop, LABEL_PREFIX, MAP, NL, SEMICOLON, statement_declarations, statement_instruction, statement_label, strdup(), and this_entity_cdeclaration().

Referenced by c_code_string(), c_forloop(), c_loop(), c_sequence(), c_test(), c_unstructured(), and c_whileloop().

Here is the call graph for this function:

Here is the caller graph for this function:

c_test()

static string c_test ( test  t, bool  breakable  )

static

Definition at line 1676 of file cprettyprinter.c.

{
    string result;
    bool no_false;
    string cond, strue, sfalse;
    cond = c_expression(test_condition(t),breakable);
    strue = c_statement(test_true(t),breakable);
    no_false = empty_statement_p(test_false(t));
 
    sfalse = no_false? NULL: c_statement(test_false(t),false);
 
    result = strdup(concatenate("if (", cond, ") {" NL,
                strue,
                no_false? "}" NL: "} else {" NL,
                sfalse, "}" NL, NULL));
    free(cond);
    free(strue);
    if (sfalse) free(sfalse);
    return result;
}

References c_expression(), c_statement(), concatenate(), empty_statement_p(), free(), NL, strdup(), test_condition, test_false, and test_true.

Referenced by c_statement(), controlize_forloop(), controlize_loop(), controlize_repeatloop(), controlize_whileloop(), and link_3_control_nodes().

Here is the call graph for this function:

Here is the caller graph for this function:

c_type_string()

static string c_type_string ( type  t )

static

Definition at line 307 of file cprettyprinter.c.

{
    string result = "UNKNOWN_TYPE" SPACE;
    switch (type_tag(t))
    {
        case is_type_variable:
            {
                basic b = variable_basic(type_variable(t));
                result = c_basic_string(b);
                break;
            }
        case is_type_void:
            {
                result = "void" SPACE;
                break;
            }
        case is_type_struct:
            {
                result = "struct" SPACE;
                break;
            }
        case is_type_union:
            {
                result = "union" SPACE;
                break;
            }
        case is_type_enum:
            {
                result = "enum" SPACE;
                break;
            }
    default:
      pips_user_warning("case not handled yet \n");
    }
    return strdup(result);
}

References c_basic_string(), is_type_enum, is_type_struct, is_type_union, is_type_variable, is_type_void, pips_user_warning, SPACE, strdup(), type_tag, type_variable, and variable_basic.

Referenced by c_basic_string(), and this_entity_cdeclaration().

Here is the call graph for this function:

Here is the caller graph for this function:

c_unstructured()

static string c_unstructured ( unstructured  u, bool  breakable  )

static

build an arbitrary reverse trail of control nodes

Copy from text_trail ...

A GOTO must be generated to reach the control successor

Is there a textual successor?

This may happen after restructuring

succ2 must be reached by GOTO

succ1 must be reached by GOTO

Both successors must be labelled

Both successors must be textual predecessors

Definition at line 1510 of file cprettyprinter.c.

{
    string result = "";
    /* build an arbitrary reverse trail of control nodes */
    list trail = unstructured_to_trail(u);
    list cc = NIL;
    trail = gen_nreverse(trail);
    ifdebug(3)
    {
        printf("Print trail: \n");
        dump_trail(trail);
    }
    /* Copy from text_trail ...*/
    for(cc=trail; !ENDP(cc); POP(cc))
    {
        control c = CONTROL(CAR(cc));
        const char* l;
        int nsucc = gen_length(control_successors(c));
        statement st = control_statement(c);
        ifdebug(3)
        {
            printf("Processing statement:\n");
            print_statement(st);
        }
        switch(nsucc)
        {
            case 0:
                {       
                    printf("nsucc = 0 \n");
                    result = strdup(concatenate(result,c_statement(st,false),NULL));
                    break;
                }
            case 1:
                {
                    control succ = CONTROL(CAR(control_successors(c)));
                    printf("nsucc = 1 \n");
                    if(check_io_statement_p(control_statement(succ)) &&
                            !get_bool_property("PRETTYPRINT_CHECK_IO_STATEMENTS"))
                    {
                        succ = CONTROL(CAR(CDR(control_successors(succ))));
                        if(check_io_statement_p(control_statement(succ)) &&
                                !get_bool_property("PRETTYPRINT_CHECK_IO_STATEMENTS"))
                        {
 
                            succ = CONTROL(CAR(CDR(control_successors(succ))));
                        }
                        pips_assert("The successor is not a check io statement",
                                !check_io_statement_p(control_statement(succ)));
                    }
 
                    result = strdup(concatenate(result,c_statement(st,false),NULL));
                    if(statement_does_return(st))
                    {
                        if(!ENDP(CDR(cc)))
                        {
                            control tsucc = CONTROL(CAR(CDR(cc)));
                            if(tsucc==succ)
                            {
                                break;
                            }
                        }
                        /* A GOTO must be generated to reach the control successor */
 
                        l = label_local_name(statement_label(control_statement(succ)));
                        pips_assert("Must be labelled", l!= string_undefined);
                        result = strdup(concatenate(result,"goto ",l,SEMICOLON,NULL));
                    }
                    break;
                }
            case 2:
                {
                    control succ1 = CONTROL(CAR(control_successors(c)));
                    control succ2 = CONTROL(CAR(CDR(control_successors(c))));
                    instruction i = statement_instruction(st);
                    test t = instruction_test(i);
                    bool no_endif = false;
                    string str = NULL;
                    printf("nsucc = 2 \n");
                    pips_assert("must be a test", instruction_test_p(i));
 
                    result = strdup(concatenate(result,"if (",c_expression(test_condition(t),breakable), ") {", NL, NULL));
                    printf("Result = %s\n",result);
 
                    /* Is there a textual successor? */
                    if(!ENDP(CDR(cc)))
                    {
                        control tsucc = CONTROL(CAR(CDR(cc)));
                        if(tsucc==succ1)
                        {
                            if(tsucc==succ2)
                            {
                                /* This may happen after restructuring */
                                printf("This may happen after restructuring\n");
                                ;
                            }
                            else
                            {
                                /* succ2 must be reached by GOTO */
                                printf("succ2 must be reached by GOTO\n");
                                l = label_local_name(statement_label(control_statement(succ2)));
                                pips_assert("Must be labelled", l!= string_undefined);
                                str = strdup(concatenate("}",NL, "else {",NL,"goto ", l, SEMICOLON,"}",NL,NULL));
                                printf("str = %s\n",str);
                            }
                        }
                        else
                        {
                            if(tsucc==succ2)
                            {
                                /* succ1 must be reached by GOTO */
                                printf("succ1 must be reached by GOTO\n");
                                l = label_local_name(statement_label(control_statement(succ1)));
                                pips_assert("Must be labelled", l!= string_undefined);
                                no_endif = true;
                            }
                            else
                            {
                                /* Both successors must be labelled */
                                printf("Both successors must be labelled\n");
                                l = label_local_name(statement_label(control_statement(succ1)));
                                pips_assert("Must be labelled", l!= string_undefined);
                                str = strdup(concatenate("goto ", l, SEMICOLON, "}", NL,"else {",NL,NULL));
                                l = label_local_name(statement_label(control_statement(succ2)));
                                pips_assert("Must be labelled", l!= string_undefined);  
                                str = strdup(concatenate(str,"goto ", l, SEMICOLON, NULL));
                                printf("str = %s\n",str);
                            }
                        }
                    }
                    else
                    {
                        /* Both successors must be textual predecessors */
                        printf("Both successors must be textual predecessors \n");
                        l = label_local_name(statement_label(control_statement(succ1)));
                        pips_assert("Must be labelled", l!= string_undefined);
                        str = strdup(concatenate("goto ", l, SEMICOLON, "}",NL,"else {",NL,NULL));
                        l = label_local_name(statement_label(control_statement(succ2)));
                        pips_assert("Must be labelled", l!= string_undefined);
                        str = strdup(concatenate(str,"goto ", l, SEMICOLON, "}",NL, NULL));
                        printf("str = %s\n",str);
                    }
 
                    if(no_endif)
                    {
                        printf("No endif\n");
                        result = strdup(concatenate(result," goto ", l, SEMICOLON, "}",NL,NULL));
                        printf("Result = %s\n",result);
                    }
                    printf("Result before = %s\n",result);
                    if (str != NULL)
                    {
                        printf("str before = %s\n",str);
                        result = strdup(concatenate(result,str,NULL));
                    }
                    printf("Result after = %s\n",result);
                    break;
                }
            default:
                pips_internal_error("Too many successors for a control node");
        }
    }
 
    gen_free_list(trail);
    return result;
}

References s_ppt::c, c_expression(), c_statement(), CAR, CDR, check_io_statement_p(), concatenate(), CONTROL, control_statement, control_successors, dump_trail(), ENDP, gen_free_list(), gen_length(), gen_nreverse(), get_bool_property(), ifdebug, instruction_test, instruction_test_p, label_local_name(), NIL, NL, pips_assert, pips_internal_error, POP, print_statement(), printf(), SEMICOLON, statement_does_return(), statement_instruction, statement_label, strdup(), string_undefined, test_condition, and unstructured_to_trail().

Referenced by c_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

c_whileloop()

static string c_whileloop ( whileloop  w )

static

partial implementation...

o while and while do loops

Definition at line 1743 of file cprettyprinter.c.

{
    /* partial implementation... */
    string result;
    string body = c_statement(whileloop_body(w),true);
    string cond = c_expression(whileloop_condition(w),true);
    evaluation eval = whileloop_evaluation(w);
    /*do while and while do loops */
    if (evaluation_before_p(eval))
        result = strdup(concatenate("while (", cond, ") {" NL,
                    body, "}" NL, NULL));
    else
        result = strdup(concatenate("do " NL, "{" NL,
                    body, "}" NL,"while (", cond, ");" NL, NULL));
    free(cond);
    free(body);
    return result;
}

References c_expression(), c_statement(), concatenate(), eval(), evaluation_before_p, free(), NL, strdup(), whileloop_body, whileloop_condition, and whileloop_evaluation.

Referenced by c_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

const_wrapper()

static void const_wrapper ( char **  s )

static

search fortran constant

Definition at line 149 of file cprettyprinter.c.

{
  static char * const_to_c[][2] = {     { ".true." , "1" } , { ".false." , "0" }};
  static const int const_to_c_sz = sizeof(const_to_c)/sizeof(*const_to_c);
  int i;
  pips_debug (5, "constant to convert : %s\n", *s);
  if (convert_double_value (s) == false) {
        /* search fortran constant */
        char *name = strlower(strdup(*s),*s);
        for(i=0;i<const_to_c_sz;i++)
          {
                if(strcmp(name,const_to_c[i][0]) == 0 )
        {
            free(*s);
            *s = strdup(const_to_c[i][1]);
            break;
        }
          }
        free(name);
  }
  pips_debug (5, "constant converted : %s\n", *s);
}

References convert_double_value(), free(), pips_debug, strdup(), and strlower().

Referenced by c_call().

Here is the call graph for this function:

Here is the caller graph for this function:

convert_double_value()

static bool convert_double_value ( char **  str )

static

test if the string looks like a REAL*8 (double in C) declaration i.e something like 987987D54654 : a bunch of digit with a letter in the middle.

if yes convert it to C (i.e replace D by E) and return true

Definition at line 123 of file cprettyprinter.c.

                                            {
  bool result = true;
  int match = 0;
  int i = 0;
  pips_debug (5, "test if str : %s is a double value. %c 0 = \n", *str, '0');
  for (i = 0; ((*str)[i] != '\0') && (result == true); i++) {
        bool cond = ((*str)[i] == 'D') && (match == 0);
        if (cond == true) {
          match = i;
          continue;
        }
        result &= (((*str)[i] >= '0') && ((*str)[i] <= '9')) || ((*str)[i] == '.') || (cond);
  }
  pips_debug (5, "end with i = %d, match = %d result = %s\n",
                          i, match, (result)?"true":"false");
  result &= ((*str)[i] == '\0') && (match + 1 != i) && (match != 0);
  if (result == true) {
        *str = strdup (*str);
        (*str)[match] = 'E';
  }
  return result;
}

References pips_debug, and strdup().

Referenced by const_wrapper().

Here is the call graph for this function:

Here is the caller graph for this function:

expression_needs_parenthesis_p()

static bool expression_needs_parenthesis_p ( expression  e )

static

Definition at line 1381 of file cprettyprinter.c.

{
    syntax s = expression_syntax(e);
    switch (syntax_tag(s))
    {
        case is_syntax_call:
            {
                struct s_ppt * p = get_ppt(call_function(syntax_call(s)));
                return p->ppt==ppt_binary;
            }
        case is_syntax_reference:
        case is_syntax_range:
        default:
            return false;
    }
}

References call_function, expression_syntax, get_ppt(), is_syntax_call, is_syntax_range, is_syntax_reference, s_ppt::ppt, ppt_binary(), syntax_call, and syntax_tag.

Referenced by ppt_binary().

Here is the call graph for this function:

Here is the caller graph for this function:

get_c_full_name()

static void get_c_full_name ( string *  base_in_c, basic  b  )

static

fill the c_base_name to get the c full name accorgind to its basic

Definition at line 1095 of file cprettyprinter.c.

                                                         {
  pips_debug (7, "find the C function for \"%s\" according to the basic\n",
                          *base_in_c);
  pips_assert ("cant deal with basic undefined", b != basic_undefined);
  // initialize some varaibles
  c_full_name * table = c_base_name_to_c_full_name;
  enum basic_utype type = basic_tag (b);
  intptr_t size = basic_type_size (b);
 
  // find the correct row
  while ((table->c_base_name != NULL) &&
                 !(same_string_p(*base_in_c, table->c_base_name) &&
                   (table->type == type) &&
                   (table->size == size)))
        table++;
  if (table->c_base_name == NULL) {
    pips_internal_error("can not determin the c function to call");
  }
  str_append  (base_in_c, table->suffix);
  str_prepend (base_in_c, table->prefix);
  return;
}

References basic_tag, basic_type_size(), basic_undefined, c_full_name::c_base_name, c_base_name_to_c_full_name, intptr_t, pips_assert, pips_debug, pips_internal_error, c_full_name::prefix, same_string_p, c_full_name::size, str_append(), str_prepend(), c_full_name::suffix, and c_full_name::type.

Referenced by ppt_math().

Here is the call graph for this function:

Here is the caller graph for this function:

get_ppt()

static struct s_ppt* get_ppt ( entity  f )

static

return the prettyprinter structure for c.

Definition at line 1372 of file cprettyprinter.c.

{
    const char* called = entity_local_name(f);
    struct s_ppt * table = intrinsic_to_c;
    while (table->intrinsic && !same_string_p(called, table->intrinsic))
        table++;
    return table;
}

References entity_local_name(), f(), s_ppt::intrinsic, intrinsic_to_c, and same_string_p.

Referenced by c_call(), and expression_needs_parenthesis_p().

Here is the call graph for this function:

Here is the caller graph for this function:

interface_argument_declaration()

static string interface_argument_declaration ( entity  module, string  separator, string  indent  )

static

Returns

the string representation of the arguments of the given modules to be used as a variable declaration in an interface.

Parameters

module,the	module to get the declaration.
separator,the	separatot to be used between vars.
lastsep,set	to true if a final separator is needed.

Definition at line 2021 of file cprettyprinter.c.

                                                             {
  code c;
  string tmp = NULL;
  string args = strdup ("");
  string result = NULL;
 
  pips_assert("it is a code", value_code_p(entity_initial(module)));
 
  c = value_code(entity_initial(module));
  FOREACH(ENTITY, var,code_declarations(c)) {
    if (argument_p(var) == true) {
      tmp = args;
      args = strdup (concatenate (args, indent,
                                  interface_argument_type_string (var),
                                  " :: ",
                                  c_entity_local_name (var),
                                  separator,
                                  NULL));
      free(tmp);
    }
  }
  result = strdup (args);
  free (args);
  return result;
}

References argument_p(), s_ppt::c, c_entity_local_name(), code_declarations, concatenate(), ENTITY, entity_initial, FOREACH, free(), interface_argument_type_string(), module, pips_assert, strdup(), value_code, and value_code_p.

Referenced by interface_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

interface_argument_type_string()

static string interface_argument_type_string ( entity  var )

static

return a string representation of the type to be used for a variable decalaration in an interface module in order to ensure that the C function can be called from fotran codes

Definition at line 2003 of file cprettyprinter.c.

                                                          {
  pips_assert("this function is deicated to arguments", argument_p(var));
  string result = NULL;
  type t = entity_type(var);
  variable v = type_variable(t);
  if (variable_dimensions (v) != NULL) {
    result = strdup ("type (c_ptr), value");
  } else {
    result = interface_type_string(t, true);
  }
  return result;
}

References argument_p(), entity_type, interface_type_string(), pips_assert, strdup(), type_variable, and variable_dimensions.

Referenced by interface_argument_declaration().

Here is the call graph for this function:

Here is the caller graph for this function:

interface_basic_string()

static string interface_basic_string ( basic  b, bool  value  )

static

Convert the fortran basic to its interface string value.

Parameters

b,the	basic to be converted to string
value,set	to true if the var has to be passed by value

case 1: result = "char";

break;

case 2: result = "short";

break;

case 6: result = "long";

break;

case 11: result = "unsigned char";

break;

case 12: result = "unsigned short";

break;

case 14: result = "unsigned int";

break;

case 16: result = "unsigned long";

break;

case 18: result = "unsigned long long";

break;

case 21: result = "signed char";

break;

case 22: result = "signed short";

break;

case 24: result = "signed int";

break;

case 26: result = "signed long";

break;

case 28: result = "signed long long";

break;

Definition at line 1871 of file cprettyprinter.c.

{
  const char* result = "UNKNOWN_BASIC" SPACE;
  char * aresult=NULL;
  bool user_type = get_bool_property ("CROUGH_USER_DEFINED_TYPE");
  switch (basic_tag(b)) {
  case is_basic_int: {
    pips_debug(2,"Basic int\n");
    if (user_type == false) {
      switch (basic_int(b)) {
      /* case 1: result = "char"; */
      /*        break; */
      /* case 2: result = "short"; */
      /*        break; */
      case 4:
        result = "integer (c_int)";
        break;
      /* case 6: result = "long"; */
      /*        break; */
      case 8:
        result = "integer (c_size_t)";
        break;
      /* case 11: result = "unsigned char"; */
      /*        break; */
      /* case 12: result = "unsigned short"; */
      /*        break; */
      /* case 14: result = "unsigned int"; */
      /*        break; */
      /* case 16: result = "unsigned long"; */
      /*        break; */
      /* case 18: result = "unsigned long long"; */
      /*        break; */
      /* case 21: result = "signed char"; */
      /*        break; */
      /* case 22: result = "signed short"; */
      /*        break; */
      /* case 24: result = "signed int"; */
      /*        break; */
      /* case 26: result = "signed long"; */
      /*        break; */
      /* case 28: result = "signed long long"; */
      /*        break; */
      default:
        pips_assert ("not handle case", false);
        break;
      }
    } else {
      result = get_string_property ("CROUGH_INTEGER_TYPE");
    }
    break;
  }
  case is_basic_float: {
    if (user_type == false) {
      switch (basic_float(b)){
      case 4: result = "real (c_float)";
        break;
      case 8: result = "real (c_double)";
        break;
      }
    } else {
      result = get_string_property ("CROUGH_REAL_TYPE");
    }
    break;
  }
  case is_basic_logical:
    result = "integer (c_int)";
    break;
  case is_basic_string:
    result = "character (c_char)";
    break;
  case is_basic_bit:
    pips_internal_error("unhandled case");
    break;
  case is_basic_pointer:
    {
      if (value == true) {
        type t = basic_pointer(b);
        pips_debug(2,"Basic pointer\n");
        aresult = interface_type_string (t, false);
        if (!type_void_p (t)) 
        return aresult;
      }
      else {
        result = "type (c_ptr)";
      }
      break;
    }
  case is_basic_derived:
    pips_internal_error("unhandled case");
    break;
  case is_basic_typedef:
    pips_internal_error("unhandled case");
  default:
    pips_internal_error("unhandled case");
  }
  if (value == true) {
      if(!aresult)aresult=strdup(result);
      char * tmp =aresult;
        aresult = strdup(concatenate (aresult, ", value", NULL));
        free(tmp);
    return aresult;
  }
  return strdup(result) ;
}

References basic_float, basic_int, basic_pointer, basic_tag, concatenate(), free(), get_bool_property(), get_string_property(), interface_type_string(), is_basic_bit, is_basic_derived, is_basic_float, is_basic_int, is_basic_logical, is_basic_pointer, is_basic_string, is_basic_typedef, pips_assert, pips_debug, pips_internal_error, SPACE, strdup(), and type_void_p.

Referenced by interface_type_string().

Here is the call graph for this function:

Here is the caller graph for this function:

interface_code_string()

static string interface_code_string ( entity  module, _UNUSED_ statement  stat  )

static

Definition at line 2078 of file cprettyprinter.c.

{
  string name      = NULL;
  string decls     = NULL;
  string result    = NULL;
  string signature = NULL;
 
  pips_assert("only available for subroutines, to be implemented for functions",
              entity_subroutine_p(module));
 
  name = c_entity_local_name (module);
  signature = interface_signature (module);
  decls = interface_argument_declaration (module, "\n", "\t\t\t");
 
  result = strdup(concatenate ("module ", name, "_interface\n",
                               "\tinterface\n",
                               "\t\tsubroutine ", name, signature,
                               " bind(C, name = \"", name, "\")\n",
                               "\t\t\tuse iso_c_binding\n", decls,
                               "\t\tend subroutine ", name,
                               "\n\tend interface\n",
                               "end module ", name, "_interface\n",
                               NULL));
  free (name);
  free (decls);
  free (signature);
 
  return result;
}

References c_entity_local_name(), concatenate(), entity_subroutine_p(), free(), interface_argument_declaration(), interface_signature(), module, pips_assert, and strdup().

Referenced by print_interface().

Here is the call graph for this function:

Here is the caller graph for this function:

interface_signature()

static string interface_signature ( entity  module )

static

return the interface signature for a module, i.e.

the list of the variable names that are comma serparated.

Definition at line 2050 of file cprettyprinter.c.

{
    code c = code_undefined;
    bool first = true;
    string tmp = NULL;
    string args = strdup ("(");
    string result = NULL;
 
    pips_assert("it is a function", type_functional_p(entity_type(module)));
    pips_assert("it is a code", value_code_p(entity_initial(module)));
 
    c = value_code(entity_initial(module));
 
    FOREACH(ENTITY, var,code_declarations(c)) {
      if (argument_p (var) == true) {
        tmp = args;
        args = strdup (concatenate (args, first == true ? "" : ", ",
                                    c_entity_local_name (var), NULL));
        free(tmp);
        first = false;
      }
    }
 
    result = strdup (concatenate (args, ")", NULL));
    free (args);
    return result;
}

References argument_p(), s_ppt::c, c_entity_local_name(), code_declarations, code_undefined, concatenate(), ENTITY, entity_initial, entity_type, FOREACH, free(), module, pips_assert, strdup(), type_functional_p, value_code, and value_code_p.

Referenced by interface_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

interface_type_string()

static string interface_type_string ( type  t, bool  value  )

static

Parameters

t,the	type to be converted to its string representation
value,set	to true if the associated argument is passed by value (i.e. not by pointer)

Definition at line 1979 of file cprettyprinter.c.

{
    string result ;
    switch (type_tag(t)) {
    case is_type_variable: {
      basic b = variable_basic(type_variable(t));
      result = interface_basic_string(b, value);
      break;
    }
    case is_type_void: {
      result = strdup ("type (c_ptr)");
      break;
    }
    default:
      pips_user_error("case not handled yet \n");
      // dead code to avoid compiler warnings.
      result = NULL;
    }
    return result;
}

References interface_basic_string(), is_type_variable, is_type_void, pips_user_error, strdup(), type_tag, type_variable, and variable_basic.

Referenced by interface_argument_type_string(), and interface_basic_string().

Here is the call graph for this function:

Here is the caller graph for this function:

parameter_or_variable_p()

static bool parameter_or_variable_p ( entity  e )

static

Definition at line 786 of file cprettyprinter.c.

{
    return parameter_p(e) || variable_p(e);
}

References parameter_p(), and variable_p().

Referenced by c_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

parameter_p()

static bool parameter_p ( entity  e )

static

Constant variables

Definition at line 771 of file cprettyprinter.c.

{
    /* Constant variables */
    return storage_rom_p(entity_storage(e)) &&
        value_symbolic_p(entity_initial(e)) &&
        type_functional_p(entity_type(e));
}

References entity_initial, entity_storage, entity_type, storage_rom_p, type_functional_p, and value_symbolic_p.

Referenced by parameter_or_variable_p().

Here is the caller graph for this function:

ppt_binary()

static string ppt_binary ( const char *  in_c, list  le  )

static

Definition at line 990 of file cprettyprinter.c.

{
    string result;
    expression e1, e2;
    string s1, s2;
    bool p1, p2;
 
    pips_assert("2 arguments to binary call", gen_length(le)==2);
 
    e1 = EXPRESSION(CAR(le));
    p1 = expression_needs_parenthesis_p(e1);
    s1 = c_expression(e1,false);
 
    e2 = EXPRESSION(CAR(CDR(le)));
    p2 = expression_needs_parenthesis_p(e2);
    s2 = c_expression(e2,false);
 
    result = strdup(concatenate(p1? OPENPAREN: EMPTY, s1, p1? CLOSEPAREN: EMPTY,
                SPACE, in_c, SPACE,
                p2? OPENPAREN: EMPTY, s2, p2? CLOSEPAREN: EMPTY,
                NULL));
 
    free(s1);
    //free(s2);
 
    return result;
}

References c_expression(), CAR, CDR, CLOSEPAREN, concatenate(), EMPTY, EXPRESSION, expression_needs_parenthesis_p(), free(), gen_length(), OPENPAREN, pips_assert, s1, SPACE, and strdup().

Referenced by expression_needs_parenthesis_p().

Here is the call graph for this function:

Here is the caller graph for this function:

ppt_call()

static string ppt_call ( const char *  in_c, list  le  )

static

SG: PBM spotted HERE.

Attention: not like this for io statements

Definition at line 1039 of file cprettyprinter.c.

{
    string scall, old;
        bool pointer = !get_bool_property ("CROUGH_SCALAR_BY_VALUE_IN_FCT_CALL");
    if (le == NIL)
    {
        scall = strdup(concatenate(in_c, "()", NULL));
    }
    else
    {
        bool first = true;
        scall = strdup(concatenate(in_c, OPENPAREN, NULL));
 
        /* Attention: not like this for io statements*/
        FOREACH (EXPRESSION, e, le)
        {
            string arg = c_expression(e,false);
            old = scall;
            scall = strdup(concatenate(old, first? "" : ", ",
                                       expression_scalar_p(e) && pointer ? "&" : "",
                                       arg, NULL));
            free(arg);
            free(old);
            first = false;
        }
 
        old = scall;
        scall = strdup(concatenate(old, CLOSEPAREN, NULL));
        free(old);
    }
    return scall;
}

References c_expression(), CLOSEPAREN, concatenate(), EXPRESSION, expression_scalar_p, FOREACH, free(), get_bool_property(), NIL, OPENPAREN, and strdup().

Referenced by ppt_math(), and ppt_unknown().

Here is the call graph for this function:

Here is the caller graph for this function:

ppt_math()

static string ppt_math ( const char *  in_c, list  le  )

static

Definition at line 1121 of file cprettyprinter.c.

{
  basic res_basic = basic_undefined;
  pips_assert ("need at least one argument", 0 != gen_length (le));
  FOREACH (EXPRESSION, exp, le) {
        pips_debug (7, "let's analyse the expression to find the involved types\n");
        type tmp = expression_to_type (exp);
        pips_assert ("type must be a variable", type_variable_p (tmp) == true);
        basic cur_b = variable_basic (type_variable (tmp));
        pips_assert ("expression_to_type returns a basic undefined",
                                 cur_b != basic_undefined);
        if (res_basic == basic_undefined) {
          res_basic = copy_basic (cur_b);
        }
        else {
          basic old = res_basic;
          res_basic = basic_maximum (old, cur_b);
          free_basic (old);
          pips_assert ("expression_to_type returns a basic undefined",
                       !basic_overloaded_p (res_basic));
        }
        free_type (tmp);
  }
  string str_copy = strdup (in_c);
  get_c_full_name (&str_copy, res_basic);
  string result = ppt_call (str_copy, le);
  if (res_basic != basic_undefined)
        free_basic (res_basic);
  free (str_copy);
  return result;
}

References basic_maximum(), basic_overloaded_p, basic_undefined, copy_basic(), exp, EXPRESSION, expression_to_type(), FOREACH, free(), free_basic(), free_type(), gen_length(), get_c_full_name(), pips_assert, pips_debug, ppt_call(), strdup(), type_variable, type_variable_p, and variable_basic.

Here is the call graph for this function:

ppt_min_max()

static string ppt_min_max ( const char *  in_c, list  le  )

static

Definition at line 1156 of file cprettyprinter.c.

{
  bool flag = false;
  bool pointer = !get_bool_property ("CROUGH_SCALAR_BY_VALUE_IN_FCT_CALL");
  expression exp = EXPRESSION (CAR (le));
  string arg = c_expression (exp, false);
  string result = strdup(concatenate ((expression_scalar_p(exp) &&
                                                                           pointer)? "&" : "", arg, NULL));
  POP (le);
  free (arg);
 
  FOREACH (EXPRESSION, e, le){
        arg = c_expression(e,false);
        string old = result;
        result = strdup(concatenate(in_c , OPENPAREN, old, ", ",
                                                                expression_scalar_p(e) && pointer ? "&" : "",
                                                                arg, CLOSEPAREN, NULL));
        free(arg);
        free(old);
        flag = true;
  }
 
  pips_assert ("min and max should have at least 2 arguments", flag == true);
  return result;
}

References c_expression(), CAR, CLOSEPAREN, concatenate(), exp, EXPRESSION, expression_scalar_p, FOREACH, free(), get_bool_property(), OPENPAREN, pips_assert, POP, and strdup().

Here is the call graph for this function:

ppt_must_error()

static string ppt_must_error ( const char *  in_f, _UNUSED_ list  le  )

static

Parameters

in_f,the

instrinsic in fortran

Definition at line 1196 of file cprettyprinter.c.

{
  string result = strdup ("");
  pips_user_error("This intrinsic should not be found in a fortran code: %s\n",
                                  in_f);
  return result;
}

ppt_unary()

static string ppt_unary ( const char *  in_c, list  le  )

static

Definition at line 1018 of file cprettyprinter.c.

{
    string e, result;
    pips_assert("one arg to unary call", gen_length(le)==1);
    e = c_expression(EXPRESSION(CAR(le)),false);
    result = strdup(concatenate(in_c, SPACE, e, NULL));
    free(e);
    return result;
}

References c_expression(), CAR, concatenate(), EXPRESSION, free(), gen_length(), pips_assert, SPACE, and strdup().

Here is the call graph for this function:

ppt_unary_post()

static string ppt_unary_post ( const char *  in_c, list  le  )

static

Definition at line 1028 of file cprettyprinter.c.

{
    string e, result;
    pips_assert("one arg to unary call", gen_length(le)==1);
    e = c_expression(EXPRESSION(CAR(le)),false);
    result = strdup(concatenate(e, SPACE, in_c, NULL));
    free(e);
    return result;
}

References c_expression(), CAR, concatenate(), EXPRESSION, free(), gen_length(), pips_assert, SPACE, and strdup().

Here is the call graph for this function:

ppt_unknown()

static string ppt_unknown ( const char *  in_f, list  le  )

static

Parameters

in_f,the

instrinsic in fortran

Definition at line 1185 of file cprettyprinter.c.

{
  if (get_bool_property ("CROUGH_PRINT_UNKNOWN_INTRINSIC") == false)
        pips_user_error ("This intrinsic can not be tranbslated in c: %s\n", in_f);
  string result = ppt_call (in_f, le);
  return result;
}

References get_bool_property(), pips_user_error, and ppt_call().

Here is the call graph for this function:

print_c_code()

bool print_c_code

(

const char *

module_name

)

C indentation thru indent.

Parameters

module_name

odule_name

Definition at line 2262 of file cprettyprinter.c.

{
    string crough, cpretty, dir, cmd;
 
    crough = db_get_memory_resource(DBR_CROUGH, module_name, true);
    cpretty = db_build_file_resource_name(DBR_C_PRINTED_FILE, module_name, CPRETTY);
    dir = db_get_current_workspace_directory();
 
    cmd = strdup(concatenate(INDENT, " ",
                dir, "/", crough, " -st > ",
                dir, "/", cpretty, NULL));
 
    safe_system(cmd);
 
    DB_PUT_FILE_RESOURCE(DBR_C_PRINTED_FILE, module_name, cpretty);
    free(cmd);
    free(dir);
 
    return true;
}

References concatenate(), CPRETTY, db_build_file_resource_name(), db_get_current_workspace_directory(), db_get_memory_resource(), DB_PUT_FILE_RESOURCE, free(), INDENT, module_name(), safe_system(), and strdup().

Here is the call graph for this function:

print_crough()

bool print_crough

(

const char *

module_name

)

save to file

Parameters

module_name

odule_name

Definition at line 2194 of file cprettyprinter.c.

{
    FILE * out;
    string ppt, crough, dir, filename;
    entity module;
    statement stat;
    list l_effect = NULL;
 
    // get what is needed from PIPS DBM
    crough = db_build_file_resource_name(DBR_CROUGH, module_name, CROUGH);
    module = module_name_to_entity(module_name);
    dir = db_get_current_workspace_directory();
    filename = strdup(concatenate(dir, "/", crough, NULL));
    stat = (statement) db_get_memory_resource(DBR_CODE, module_name, true);
    l_effect = effects_to_list((effects)
                               db_get_memory_resource(DBR_SUMMARY_EFFECTS,
                                                      module_name, true));
    set_current_module_entity(module);
    set_current_module_statement(stat);
 
    debug_on("CPRETTYPRINTER_DEBUG_LEVEL");
    pips_debug(1, "Begin C prettyprrinter for %s\n", entity_name(module));
 
    // init the list needed for the function pre and postlude
    l_type    = NIL;
    l_name    = NIL;
    l_rename  = NIL;
    l_entity  = NIL;
    l_written = NIL;
    // build the list of written entity
    build_written_list (l_effect);
 
    // get the c code as a string
    ppt = c_code_string(module, stat);
    pips_debug(1, "end\n");
    debug_off();
 
    /* save to file */
    out = safe_fopen(filename, "w");
    fprintf(out, "/* C pretty print for module %s. */\n", module_name);
    fprintf(out, "%s", ppt);
    safe_fclose(out, filename);
 
    // free and reset strin lists
    gen_free_list (l_entity);
    gen_free_list (l_written);
    gen_free_string_list (l_type);
    gen_free_string_list (l_name);
    gen_free_string_list (l_rename);
    l_type    = NIL;
    l_name    = NIL;
    l_rename  = NIL;
    l_entity  = NIL;
    l_written = NIL;
    free(ppt);
    free(dir);
    free(filename);
 
    DB_PUT_FILE_RESOURCE(DBR_CROUGH, module_name, crough);
 
    reset_current_module_statement();
    reset_current_module_entity();
 
    return true;
}

References build_written_list(), c_code_string(), concatenate(), CROUGH, db_build_file_resource_name(), db_get_current_workspace_directory(), db_get_memory_resource(), DB_PUT_FILE_RESOURCE, debug_off, debug_on, effects_to_list(), entity_name, fprintf(), free(), gen_free_list(), gen_free_string_list(), l_entity, l_name, l_rename, l_type, l_written, module, module_name(), module_name_to_entity(), NIL, out, pips_debug, reset_current_module_entity(), reset_current_module_statement(), safe_fclose(), safe_fopen(), set_current_module_entity(), set_current_module_statement(), and strdup().

Here is the call graph for this function:

print_interface()

bool print_interface

(

const char *

module_name

)

cprettyprinter.c

save to file

Parameters

module_name

odule_name

Definition at line 2151 of file cprettyprinter.c.

{
  FILE * out;
  string interface_code, interface, dir, filename;
  entity module;
  statement stat;
 
  // get what is needed from PIPS DBM
  interface = db_build_file_resource_name(DBR_INTERFACE, module_name, INTERFACE);
  module = module_name_to_entity(module_name);
  dir = db_get_current_workspace_directory();
  filename = strdup(concatenate(dir, "/", interface, NULL));
  stat = (statement) db_get_memory_resource(DBR_CODE, module_name, true);
 
  set_current_module_entity(module);
  set_current_module_statement(stat);
 
  debug_on("INTERFACE_DEBUG_LEVEL");
  pips_debug(1, "Begin print_interface for %s\n", entity_name(module));
 
  // get the inteface code as a string
  interface_code = interface_code_string(module, stat);
  pips_debug(1, "end\n");
  debug_off();
 
  /* save to file */
  out = safe_fopen(filename, "w");
  fprintf(out, "! Fortran interface module for %s. \n", module_name);
  fprintf(out, "%s", interface_code);
  safe_fclose(out, filename);
 
  DB_PUT_FILE_RESOURCE(DBR_INTERFACE, module_name, INTERFACE);
 
  reset_current_module_statement();
  reset_current_module_entity();
 
  free (interface_code);
  free (dir);
  free (filename);
 
  return true;
}

References concatenate(), db_build_file_resource_name(), db_get_current_workspace_directory(), db_get_memory_resource(), DB_PUT_FILE_RESOURCE, debug_off, debug_on, entity_name, fprintf(), free(), INTERFACE, interface_code_string(), module, module_name(), module_name_to_entity(), out, pips_debug, reset_current_module_entity(), reset_current_module_statement(), safe_fclose(), safe_fopen(), set_current_module_entity(), set_current_module_statement(), and strdup().

Here is the call graph for this function:

scalar_by_pointer()

static bool scalar_by_pointer ( entity  var )

static

we want to decide if a scalar variable need to be passed by pointer or by value to a C function.

Fortran77 assumes that all scalars are passed by pointer. Starting With Fotran95, the arguments can be passed by value by using interfaces.

Returns

true if the variable has to be passed by pointer

Parameters

var,the

variable to be test as an entity

Definition at line 280 of file cprettyprinter.c.

                                           {
  // init result to false
  bool result = false;
  if ((get_bool_property ("CROUGH_FORTRAN_USES_INTERFACE") == false)) {
    // no interface, var is a scalar
    result = true;
  }
  else if ((get_bool_property ("CROUGH_FORTRAN_USES_INTERFACE") == true) &&
           (get_bool_property ("CROUGH_SCALAR_BY_VALUE_IN_FCT_DECL") == false) &&
           (written_p (var) == true)) {
    // interface exists but var is written (and user doesn't use the property
    // to force the passing of scalar by  value)
    result = true;
  }
 
  return result;
}

References get_bool_property(), and written_p().

Referenced by this_entity_cdeclaration().

Here is the call graph for this function:

Here is the caller graph for this function:

scalar_postlude()

static string scalar_postlude ( )

static

Definition at line 248 of file cprettyprinter.c.

                                 {
  string result = NULL;
  string previous = NULL;
  list n = l_name;
  list r = l_rename;
  list e = l_entity;
 
  for (; n != NIL && r != NIL && e != NIL; n = n->cdr, r = r->cdr, e = e->cdr) {
    if (written_p (gen_car (e))) {
      result = strdup (concatenate ("*", (string) gen_car (r), " = ",
                                    (string) gen_car (n), ";\n", previous, NULL));
      if (previous != NULL) free (previous);
      previous = result;
      pips_debug (5, "entity %s (%p) restored\n",
                  entity_local_name(gen_car (e)),
                  gen_car (e));
    } else {
      pips_debug (5, "entity %s (%p) not restored\n",
                  entity_local_name(gen_car (e)),
                  gen_car (e));
    }
  }
  return (result == NULL) ? strdup("") : result;
}

References cons::cdr, concatenate(), entity_local_name(), free(), gen_car(), l_entity, l_name, l_rename, NIL, pips_debug, strdup(), and written_p().

Referenced by c_call().

Here is the call graph for this function:

Here is the caller graph for this function:

scalar_prelude()

static string scalar_prelude ( )

static

Definition at line 231 of file cprettyprinter.c.

                                {
  string result = NULL;
  string previous = NULL;
  list t = l_type;
  list n = l_name;
  list r = l_rename;
  for (; n != NIL && r!= NIL && t!= NIL; n = n->cdr, r = r->cdr, t = t->cdr) {
    result = strdup (concatenate ((char*) gen_car (t), SPACE,
                                  (string) gen_car (n), " = ", "*",
                                  (string) gen_car (r), ";\n", previous,
                                  NULL));
    if (previous != NULL) free (previous);
    previous = result;
  }
  return (result == NULL) ? strdup("") : result;
}

References cons::cdr, concatenate(), free(), gen_car(), l_name, l_rename, l_type, NIL, SPACE, and strdup().

Referenced by c_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

this_entity_cdeclaration()

static string this_entity_cdeclaration ( entity  var, bool  fct_sig  )

static

Parameters

var,the	variable to get the c declaration
fct_sig,set	to true if the variable is part of a function signature

Many possible combinations

This is a typedef name, what about typedef int myint[5] ???

hat about real, double, string, ... ?

ram r = storage_ram(s); entity sec = ram_section(r); if ((sec == CurrentSourceFileStaticArea) || (sec == CurrentStaticArea)) result = "static ";

problems with order !

It is an expression...

Definition at line 578 of file cprettyprinter.c.

{
    string result = NULL;
    //string name = entity_local_name(var);
    type t = entity_type(var);
    storage s = entity_storage(var);
    pips_debug(2,"Entity name : %s\n",entity_name(var));
    /*  Many possible combinations */
 
    /* This is a typedef name, what about typedef int myint[5] ???  */
    if (typedef_entity_p(var))
    {
        string tmp = NULL;
        tmp=c_entity_local_name(var);
        result = strdup(concatenate("typedef ", c_type_string(t),SPACE,tmp,NULL));
        free(tmp);
        return result;
    }
 
    switch (storage_tag(s)) {
        case is_storage_rom:
            {
                value va = entity_initial(var);
                if (!value_undefined_p(va))
                {
                    constant c = NULL;
                    if (value_constant_p(va))
                        c = value_constant(va);
                    else if (value_symbolic_p(va))
                        c = symbolic_constant(value_symbolic(va));
                    if (c)
                    {
                        if (constant_int_p(c))
                        {
                            string sval = int2a(constant_int(c));
                            string svar = c_entity_local_name(var);
                            enum language_utype old_lang = get_prettyprint_language_tag();
                            set_prettyprint_language_tag (is_language_c);
                            string sbasic = basic_to_string(entity_basic(var));
                            set_prettyprint_language_tag(old_lang);
                            asprintf(&result,"static const %s %s = %s\n",sbasic,svar,sval);
                            free(sval);
                            free(svar);
                            free(sbasic);
                            return result;
                        }
                        /*What about real, double, string, ... ?*/
                    }
                }
                break;
            }
        case is_storage_ram:
            {
                /*     ram r = storage_ram(s);
                       entity sec = ram_section(r);
                       if ((sec == CurrentSourceFileStaticArea) || (sec == CurrentStaticArea))
                       result = "static ";*/
                break;
            }
        default:
            break;
    }
 
    switch (type_tag(t)) {
        case is_type_variable:
            {
                variable v = type_variable(t);
                string sptr, st, sd, svar, sq, ext;
                value val = entity_initial(var);
                st = c_basic_string(variable_basic(v));
                sd = c_dim_string(variable_dimensions(v), fct_sig);
                sq = c_qualifier_string(variable_qualifiers(v));
                svar = c_entity_local_name(var);
 
                                // In the case of a signature check if the scalars need to
                                // be passed by pointers. If the check return true
                                // a "*" must be added
                                if ((fct_sig == true) && (variable_dimensions(v) == NIL) &&
                                        (scalar_by_pointer (var) == true)) {
                                  ext = SCALAR_IN_SIG_EXT;
                                  sptr = "*";
                                  l_type   = gen_string_cons(strdup(concatenate(sq, st, NULL)),
                                                                                         l_type);
                                  l_name   = gen_string_cons(strdup(concatenate(svar, NULL)),
                                                                                         l_name);
                                  l_rename = gen_string_cons(strdup(concatenate(svar,ext,NULL)),
                                                                                         l_rename);
                                  l_entity = gen_entity_cons(var, l_entity);
                                }
                                // In case of a signature check if the arrays need to
                                // be passed by pointers. If the check return true
                                // a "*" must be added and the dim must be remove
                                else if ((fct_sig == true) && (variable_dimensions(v) != NIL) &&
                                                 (get_bool_property("CROUGH_ARRAY_PARAMETER_AS_POINTER") == true)) {
                                  ext = "";
                                  sptr = "*";
                                  free (sd);
                                  sd = strdup ("");
                                }
                                else {
                                  ext = "";
                                  sptr = "";
                                }
 
 
                /* problems with order !*/
                result = strdup(concatenate(sq, st, sptr, SPACE, svar, ext,
                                            sd, NULL));
                free(svar);
                if (!value_undefined_p(val))
                {
                    if (value_expression_p(val))
                    {
                        expression exp = value_expression(val);
                        if (brace_expression_p(exp))
                            result = strdup(concatenate(result,"=",
                                                        c_brace_expression_string(exp),NULL));
                        else
                          result = strdup(concatenate(result,"=",
                                                      expression_to_string(exp),
                                                      NULL));
                    }
                }
                if (basic_bit_p(variable_basic(v)))
                {
                    /* It is an expression... */
                    _int i = (_int) basic_bit(variable_basic(v));
                    pips_debug(2,"Basic bit %td",i);
                    result = strdup(concatenate(result,":",int2a(i),NULL));
                    user_error("this_entity_cdeclaration",
                            "Bitfield to be finished...");
                }
                free(st);
                free(sd);
                break;
            }
        case is_type_struct:
            {
                list l = type_struct(t);
                string tmp =NULL;
                tmp = c_entity_local_name(var);
                result = strdup(concatenate("struct ",tmp, "{", NL,NULL));
                free(tmp);
                MAP(ENTITY,ent,
                        {
                        string s = this_entity_cdeclaration(ent, fct_sig);
                        result = strdup(concatenate(result, s, SEMICOLON, NULL));
                        free(s);
                        },l);
                result = strdup(concatenate(result,"}", NULL));
                break;
            }
        case is_type_union:
            {
                list l = type_union(t);
                string tmp =NULL;
                tmp = c_entity_local_name(var);
                result = strdup(concatenate("union ",tmp, "{", NL,NULL));
                free(tmp);
                MAP(ENTITY,ent,
                        {
                          string s = this_entity_cdeclaration(ent, fct_sig);
                        result = strdup(concatenate(result, s, SEMICOLON, NULL));
                        free(s);
                        },l);
                result = strdup(concatenate(result,"}", NULL));
                break;
            }
        case is_type_enum:
            {
                list l = type_enum(t);
                bool first = true;
                string tmp = NULL;
                tmp = c_entity_local_name(var);
                result = strdup(concatenate("enum ", tmp, " {",NULL));
                free(tmp);
                MAP(ENTITY,ent,
                        {
                        tmp = c_entity_local_name(ent);
                        result = strdup(concatenate(result,first?"":",",tmp,NULL));
                        free(tmp);
                        first = false;
                        },l);
                result = strdup(concatenate(result,"}", NULL));
                break;
            }
        default:
            break;
    }
 
    return result? result: strdup("");
}

References asprintf, basic_bit, basic_bit_p, basic_to_string(), brace_expression_p(), c_basic_string(), c_brace_expression_string(), c_dim_string(), c_entity_local_name(), c_qualifier_string(), c_type_string(), concatenate(), constant_int, constant_int_p, ENTITY, entity_basic(), entity_initial, entity_name, entity_storage, entity_type, exp, expression_to_string(), free(), gen_entity_cons(), gen_string_cons(), get_bool_property(), get_prettyprint_language_tag(), int2a(), is_language_c, is_storage_ram, is_storage_rom, is_type_enum, is_type_struct, is_type_union, is_type_variable, l_entity, l_name, l_rename, l_type, MAP, NIL, NL, pips_debug, scalar_by_pointer(), SCALAR_IN_SIG_EXT, SEMICOLON, set_prettyprint_language_tag(), SPACE, storage_tag, strdup(), symbolic_constant, type_enum, type_struct, type_tag, type_union, type_variable, typedef_entity_p(), user_error, value_constant, value_constant_p, value_expression, value_expression_p, value_symbolic, value_symbolic_p, value_undefined_p, variable_basic, variable_dimensions, and variable_qualifiers.

Referenced by c_declarations(), and c_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

variable_p()

static bool variable_p ( entity  e )

static

Definition at line 779 of file cprettyprinter.c.

{
    storage s = entity_storage(e);
    return type_variable_p(entity_type(e)) &&
        (storage_ram_p(s) || storage_return_p(s));
}

References entity_storage, entity_type, storage_ram_p, storage_return_p, and type_variable_p.

Referenced by parameter_or_variable_p().

Here is the caller graph for this function:

written_p()

static bool written_p ( entity  e )

static

Definition at line 226 of file cprettyprinter.c.

                                 {
  return gen_in_list_p (e, l_written);
}

References gen_in_list_p(), and l_written.

Referenced by scalar_by_pointer(), and scalar_postlude().

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

c_base_name_to_c_full_name

c_full_name c_base_name_to_c_full_name[]

static

Initial value:

= {
  {"abs"   , is_basic_int     , 1  , ""     , "" }, 
  {"abs"   , is_basic_int     , 2  , ""     , "" }, 
  {"abs"   , is_basic_int     , 4  , ""     , "" }, 
  {"abs"   , is_basic_int     , 6  , "l"    , "" }, 
  {"abs"   , is_basic_int     , 8  , "ll"   , "" }, 
  {"abs"   , is_basic_float   , 4  , "f"    , "f"}, 
  {"abs"   , is_basic_float   , 8  , "f"    , "" }, 
  {"abs"   , is_basic_complex , 8  , "c"    , "f"}, 
  {"abs"   , is_basic_complex , 16 , "c"    , "" }, 
  {"pow"   , is_basic_int     , 1  , POW_PRE, "i"}, 
  {"pow"   , is_basic_int     , 2  , POW_PRE, "i"}, 
  {"pow"   , is_basic_int     , 4  , POW_PRE, "i"}, 
  {"pow"   , is_basic_int     , 6  , POW_PRE, "i"}, 
  {"pow"   , is_basic_int     , 8  , POW_PRE, "i"}, 
  {"pow"   , is_basic_float   , 4  , ""     , "f"}, 
  {"pow"   , is_basic_float   , 8  , ""     , "" }, 
  {"pow"   , is_basic_complex , 8  , "c"    , "f"}, 
  {"pow"   , is_basic_complex , 16 , "c"    , "" }, 
  {NULL    , is_basic_int     , 0  , ""     , "" }
}

Definition at line 1072 of file cprettyprinter.c.

Referenced by get_c_full_name().

intrinsic_to_c

struct s_ppt intrinsic_to_c[]

static

Definition at line 1196 of file cprettyprinter.c.

Referenced by get_ppt().

l_entity

list l_entity = NIL

static

Definition at line 107 of file cprettyprinter.c.

Referenced by print_crough(), scalar_postlude(), and this_entity_cdeclaration().

l_name

list l_name = NIL

static

Definition at line 105 of file cprettyprinter.c.

Referenced by print_crough(), scalar_postlude(), scalar_prelude(), and this_entity_cdeclaration().

l_rename

list l_rename = NIL

static

Definition at line 106 of file cprettyprinter.c.

Referenced by print_crough(), scalar_postlude(), scalar_prelude(), and this_entity_cdeclaration().

l_type

list l_type = NIL

static

Definition at line 104 of file cprettyprinter.c.

Referenced by print_crough(), scalar_prelude(), and this_entity_cdeclaration().

l_written

list l_written = NIL

static

Definition at line 108 of file cprettyprinter.c.

Referenced by build_written_list(), print_crough(), and written_p().