25 #include "pips_config.h"
76 #define IS_UPPER(c) (isascii(c) && isupper(c))
89 "have been initialized with a real value?\n",
92 "Fortran standard prohibit varying size array\n"
93 "Set property PARSER_ACCEPT_ANSI_EXTENSIONS to true.\n");
188 "Ambiguity between external %s and local %s forbidden by Fortran standard\n",
228 "Cannot save variable %s with non RAM storage (storage tag = %d)\n",
231 ParserError(
"SaveEntity",
"Cannot save this variable");
263 user_warning(
"ProcessSave",
"Variable %s has already been declared static "
264 "by appearing in Common %s\n",
266 ParserError(
"parser",
"SAVE statement incompatible with previous"
267 " COMMON declaration\n");
274 user_warning(
"parser",
"Variable %s cannot be declared static "
275 "be cause of its storage class (tag=%d)\n",
277 ParserError(
"parser",
"SAVE statement incompatible with previous"
278 " declaration (e.g. EXTERNAL).\n");
300 Warning(
"SaveCommon",
"common blocks are automatically saved\n");
315 debug(7,
"PrintData",
"Begin\n");
317 for (pc = ldvr; pc !=
NIL; pc =
CDR(pc)) {
324 debug(7,
"PrintData",
"\n");
326 for (pc = ldvl; pc !=
NIL; pc =
CDR(pc)) {
338 debug(7,
"PrintData",
"End\n\n");
365 for (pcr = ldvr; pcr !=
NIL && pcl !=
NIL; pcr =
CDR(pcr))
374 pips_debug(8,
"Storage for entity %s must be static or made static\n",
392 (
"Variable %s is declared dynamic in a BLOCKDATA\n",
395 "No dynamic variables in BLOCKDATA\n");
407 (
"DATA for variable %s declared is impossible:"
408 " it should be declared in a COMMON instead\n",
411 "Improper DATA declaration in BLOCKDATA");
418 (
"DATA for variable %s declared in COMMON %s:"
419 " not standard compliant,"
420 " use a BLOCKDATA\n",
424 "Improper DATA declaration, use a BLOCKDATA"
425 " or set property PARSER_ACCEPT_ANSI_EXTENSIONS");
433 "DATA initialization for non RAM variable %s "
434 "(storage tag = %d)\n",
437 "DATA statement initializes non RAM variable\n");
440 pips_debug(8,
"needs %d elements for entity %s\n",
467 ParserError(
"AnalyzeData",
"Too many initial values");
473 "Integer scalar variable initialized "
474 "with non-integer constant");
480 while (i > 0 && pcl !=
NIL)
489 pips_debug(8,
"satisfies %td references out of %d\n",
496 if ((pcl =
CDR(pcl)) !=
NIL) {
507 Warning(
"AnalyzeData",
"too many initializers\n");
512 ParserError(
"AnalyzeData",
"too few initializers\n");
531 pips_assert(
"The static initialization pseudo-intrinsic is defined",
553 "Set property PARSER_ACCEPT_ANSI_EXTENSIONS to true.\n");
556 if(!
ENDP(decl_dims)) {
591 "Redefinition of pointer",
597 "%s %s between lines %d and % d\n",
598 "Redefinition of type for entity",
600 ParserError(
"Syntax",
"Conflicting type declarations\n");
679 bool variable_had_implicit_type_p =
false;
702 "%s %s between lines %d and % d\n",
703 "Attempt to dimension functional entity",
705 ParserError(
"DeclareVariable",
"Likely name conflict\n");
721 "%s %s between lines %d and % d\n",
722 "Redefinition of functional type for entity",
727 "%s %s between lines %d and % d\n",
728 "Modification of functional result type for entity",
731 "Possible name conflict?\n");
744 "%s %s between lines %d and % d\n",
745 "Redefinition of dimension for entity",
747 ParserError(
"DeclareVariable",
"Name conflict?\n");
756 variable_had_implicit_type_p =
true;
765 "%s %s between lines %d and % d\n",
766 "Redefinition of dimension for entity",
768 ParserError(
"DeclareVariable",
"Name conflict?\n");
785 "Storage information for %s is likely to be wrong because its type is "
786 "redefined as a larger type\nType is *not* redefined internally to avoid "
812 "%s %s between lines %d and % d\n",
813 "Redefinition of type for formal label substitution entity",
816 "Name conflict for formal label substitution variable? "
817 "Use property PARSER_FORMAL_LABEL_SUBSTITUTE_PREFIX?\n");
822 "%s %s between lines %d and % d\n",
823 "Redefinition of type for entity",
826 "Name conflict or declaration ordering "
827 "not supported by PIPS\n"
828 "Late typing of formal parameter and/or "
829 "interference with IMPLICIT\n");
836 "%s %s between lines %d and % d\n%s\n",
837 "COMMON/VARIABLE homonymy for entity name",
839 "Rename your common.");
849 ParserError(
"DeclareVariable",
"storage non implemented\n");
862 ParserError(
"DeclareVariable",
"value non implemented\n");
878 pips_assert(
"Return variable and function must have the same name",
884 if(variable_had_implicit_type_p) {
885 debug(8,
"DeclareVariable",
" Type for result of function %s "
898 "Attempt to retype function %s with result of type "
901 ParserError(
"DeclareVariable",
"Illegal retyping");
968 ParserError(
"reset_common_size_map",
"Resetting a resetted variable!\n");
982 bool defined =
false;
1076 string nature[] = {
"function or subroutine",
"main",
"block data"};
1088 user_warning(
"NameToCommon",
"Identifier %s used for a common and for a %s\n",
1119 "Intrinsic %s overloaded by variable %s between line %d and %d\n",
1127 "Module or parameter %s declared in common %s between line %d and %d\n",
1130 "Ill. decl. of function or subroutine in a common\n");
1137 " for storage (e.g. it appears in a DATA"
1138 " and in a COMMON statement in a non "
1140 ParserError(
"AddVariableToCommon",
"Storage conflict\n");
1145 " after DATA statement for variable %s\n",
1147 ParserError(
"AddVariableToCommon",
"Storage conflict\n");
1151 "Storage tag=%d for entity %s\n",
1153 FatalError(
"AddVariableToCommon",
"storage already defined\n");
1244 "inconsistent size (%d and %d) for common /%s/ in %s\n"
1245 "Best results are obtained if all instances of a "
1246 "COMMON are declared the same way.\n",
1253 debug(1,
"update_common_sizes",
1254 "reset size %d for common %s\n", s,
entity_name(c));
1287 int lettre_d, lettre_f;
1300 for (i = lettre_d-
'A'; i <= lettre_f-
'A'; i += 1) {
1326 i = (
int) (s[0] -
'A');
1341 FatalError(
"ImplicitType",
"Unsupported overloaded tag for basic\n");
1343 FatalError(
"ImplicitType",
"Illegal tag for basic\n");
1377 i = (
int) (s[0] -
'A');
1427 pips_debug(8,
"Retype formal parameter %s\n",
1435 pips_debug(8,
"Cannot retype entity %s: warning!!!\n",
1438 " Move up the implicit statement at the beginning of declarations.\n",
1454 pips_assert(
"Parameter type list should be empty",
1463 pips_debug(8,
"Retype result of function %s\n",
1471 pips_assert(
"Result and function result types should be equal",
1487 pips_assert(
"Parameter type list should still be empty",
1532 ok = l==1 || l==2 || l==4 || l==8;
1540 ok = l==1 || l==2 || l==4 || l==8;
1551 ParserError(
"Declaration",
"incompatible type length");
1569 int idim, iindex, pid, o, ilowerbound;
1573 for (idim = 0, pid = 1, o = 0; pi != NULL; idim++, pi =
CDR(pi)) {
1580 o += ((iindex-ilowerbound)*pid);
1599 pips_assert(
"ValueOfIthLowerBound", i >= 1 && i <= 7);
1603 while (pc != NULL && --i > 0)
1607 ParserError(
"SizeOfIthLowerBound",
"not enough dimensions\n");
1629 FatalError(
"SizeOfRange",
"null increment\n");
1631 ir = ((iu-il)/ii)+1;
1634 FatalError(
"SizeOfRange",
"negative value\n");
1689 "* empty declaration list *\n\n":
"Variable list:\n\n");
1697 (void)
fprintf(stderr,
"\nLayouts for areas (commons):\n\n");
1726 pips_debug(1,
"End of declarations for module %s\n\n",
1762 bool updated =
false;
1766 debug(8,
"update_common_layout",
1772 if(!
ENDP(members)) {
1784 for(cm = members; !
ENDP(cm);
POP(cm)) {
1836 pips_assert(
"Previous must in declared in the current module",
1853 debug(8,
"update_common_layout",
1854 "End for common /%s/: updated=%s\n",
constant make_constant(enum constant_utype tag, void *val)
value make_value_unknown(void)
value make_value_code(code _field_)
language make_language_fortran(void)
type make_type_variable(variable _field_)
basic make_basic(enum basic_utype tag, void *val)
storage make_storage_rom(void)
type copy_type(type p)
TYPE.
basic copy_basic(basic p)
BASIC.
storage make_storage(enum storage_utype tag, void *val)
ram make_ram(entity a1, entity a2, intptr_t a3, list a4)
value make_value(enum value_utype tag, void *val)
dimension make_dimension(expression a1, expression a2, list a3)
bool value_defined_p(value p)
variable make_variable(basic a1, list a2, list a3)
area make_area(intptr_t a1, list a2)
code make_code(list a1, string a2, sequence a3, list a4, language a5)
void free_storage(storage p)
storage make_storage_ram(ram _field_)
sequence make_sequence(list a)
constant copy_constant(constant p)
CONSTANT.
type make_type(enum type_utype tag, void *val)
struct _newgen_struct_entity_ * entity
bool entity_is_argument_p(entity e, cons *args)
cons * arguments_add_entity(cons *a, entity e)
void const char const char const int
entity DynamicArea
These global variables are declared in ri-util/util.c.
int DefaultLengthOfBasic(tag t)
Deals with constant expressions and constant entities.
static bool same_basic_and_scalar_p(type t1, type t2)
type_equal_p -> same_basic_and_scalar_p in latter...
int CurrentOffsetOfArea(entity a, entity v)
void InitImplicit()
this function initializes the data structure used to compute implicit types
void save_initialized_variable(entity v)
void AnalyzeData(list ldvr, list ldvl)
this function scans at the same time a list of datavar and a list of dataval.
void MakeVariableStatic(entity v, bool force_it)
void update_user_common_layouts(entity m)
Check...
int SafeSizeOfArray(entity a)
This function should not be used outside of the syntax library because it depends on ParserError().
entity SafeFindOrCreateEntity(const char *package, const char *name)
Problem: A functional global entity may be referenced without parenthesis or CALL keyword in a functi...
static hash_table common_size_map
bool update_common_layout(entity m, entity c)
(Re)compute offests of all variables allocated in common c from module m and update (if necessary) th...
void update_common_to_size(entity a, size_t new_size)
int OffsetOfReference(reference r)
This function computes the numerical offset of a variable element from the begining of the variable.
int IsIntegerScalar(entity e)
FI: should be moved in ri-util; this function returns true if e is a zero dimension variable of basic...
void update_common_sizes(void)
int ValueOfIthLowerBound(entity e, int i)
this function returns the size of the ith lower bound of a variable e.
void set_common_to_size(entity a, size_t size)
void reset_common_size_map()
void add_entity_to_declarations(string name, string area_name, enum basic_utype tag, void *val)
FI: I do not understand the naming here, or the parameter.
void cr_implicit(tag t, int l, int lettre_d, int lettre_f)
this function updates the data structure used to compute implicit types.
void SaveCommon(entity c)
this function transforms a dynamic common into a static one.
void DeclareVariable(entity e, type t, list d, storage s, value v)
void DeclareVariable(e, t, d, s, v): update entity e description as declaration statements are encoun...
static tag tag_implicit[26]
local variables for implicit type implementation
void SaveEntity(entity e)
These two functions transform a dynamic variable into a static one.
void MakeDataStatement(list ldr, list ldv)
Receives as first input an implicit list of references, including implicit DO, and as second input an...
void reset_common_size_map_on_error()
bool implicit_type_p(entity e)
This function checks that entity e has an undefined or an implicit type which can be superseded by an...
void ProcessSave(entity v)
static size_t int_implicit[26]
static entity make_common_entity(entity c)
updates the common entity if necessary with the common prefix
entity MakeCommon(entity e)
MakeCommon: This function creates a common block.
void save_all_entities()
functions for the SAVE declaration
void DeclareIntrinsic(entity e)
Intrinsic e is used in the current module.
int SizeOfRange(range r)
This function computes the size of a range, ie.
entity NameToCommon(string n)
type ImplicitType(entity e)
This function computes the Fortran implicit type of entity e.
void retype_formal_parameters()
If an IMPLICIT statement is encountered, it must be applied to the formal parameters,...
void initialize_common_size_map()
size_t common_to_size(entity a)
void PrintData(cons *ldvr, cons *ldvl)
a debugging function, just in case ...
void DeclarePointer(entity ptr, entity pointed_array, list decl_dims)
type MakeFortranType(tag t, value v)
this function creates a type that represents a fortran type.
void AddVariableToCommon(entity c, entity v)
This function adds a variable v to a common block c.
bool common_to_defined_size_p(entity a)
bool fortran_relevant_area_entity_p(entity c)
These tests are needed to check area consistency when dumping or printing a symbol table.
const char * module_name(const char *s)
Return the module part of an entity name.
bool get_bool_property(const string)
FC 2015-07-20: yuk, moved out to prevent an include cycle dependency include "properties....
static char * package
The package name in which functions will be defined.
const char * get_current_module_name(void)
Get the name of the current module.
entity get_current_module_entity(void)
Get the entity of the current module.
#define ENDP(l)
Test if a list is empty.
#define POP(l)
Modify a list pointer to point on the next element of the list.
#define NIL
The empty list (nil in Lisp)
size_t gen_length(const list l)
#define CONS(_t_, _i_, _l_)
List element cell constructor (insert an element at the beginning of a list)
list gen_nconc(list cp1, list cp2)
physically concatenates CP1 and CP2 but do not duplicates the elements
#define CAR(pcons)
Get the value of the first element of a list.
void gen_free_list(list l)
free the spine of the list
#define FOREACH(_fe_CASTER, _fe_item, _fe_list)
Apply/map an instruction block on all the elements of a list.
#define CDR(pcons)
Get the list less its first element.
list gen_append(list l1, const list l2)
#define list_undefined
Undefined list definition :-)
#define MAP(_map_CASTER, _map_item, _map_code, _map_list)
Apply/map an instruction block on all the elements of a list (old fashioned)
statement make_call_statement(string, list, entity, string)
This function is limited to intrinsics calls...
hash_table hash_table_make(hash_key_type key_type, size_t size)
void * hash_get(const hash_table htp, const void *key)
this function retrieves in the hash table pointed to by htp the couple whose key is equal to key.
void hash_put(hash_table htp, const void *key, const void *val)
This functions stores a couple (key,val) in the hash table pointed to by htp.
void hash_update(hash_table htp, const void *key, const void *val)
update key->val in htp, that MUST be pre-existent.
void hash_table_free(hash_table htp)
this function deletes a hash table that is no longer useful.
#define full_name(dir, name)
#define pips_debug
these macros use the GNU extensions that allow variadic macros, including with an empty list.
#define pips_user_warning
#define pips_assert(what, predicate)
common macros, two flavors depending on NDEBUG
#define pips_internal_error
#define user_warning(fn,...)
void debug(const int the_expected_debug_level, const char *calling_function_name, const char *a_message_format,...)
ARARGS0.
#define DYNAMIC_AREA_LOCAL_NAME
#define TOP_LEVEL_MODULE_NAME
Module containing the global variables in Fortran and C.
#define STACK_AREA_LOCAL_NAME
#define STATIC_AREA_LOCAL_NAME
#define MODULE_SEP_STRING
#define HEAP_AREA_LOCAL_NAME
void print_arguments(list args)
string bool_to_string(bool)
string concatenate(const char *,...)
Return the concatenation of the given strings.
#define HASH_MAP(k, v, code, ht)
#define HASH_UNDEFINED_VALUE
value returned by hash_get() when the key is not found; could also be called HASH_KEY_NOT_FOUND,...
#define hash_table_undefined
Value of an undefined hash_table.
void * gen_find_tabulated(const char *, int)
int f(int off1, int off2, int n, float r[n], float a[n], float b[n])
#define DATAVAL(x)
DATAVAL.
#define datavar_nbelements(x)
#define dataval_constant(x)
#define DATAVAR(x)
DATAVAR.
#define dataval_nboccurrences(x)
#define datavar_variable(x)
string basic_to_string(basic)
bool ghost_variable_entity_p(entity e)
static int tc
Internal variables
#define UNBOUNDED_DIMENSION_NAME
#define STATIC_INITIALIZATION_NAME
#define make_entity(n, t, s, i)
#define DATA_LIST_FUNCTION_NAME
#define UNKNOWN_RAM_OFFSET
bool dynamic_area_p(entity aire)
void print_common_layout(FILE *fd, entity c, bool debug_p)
bool stack_area_p(entity aire)
bool heap_area_p(entity aire)
int current_offset_of_area(entity a, entity v)
bool static_area_p(entity aire)
bool entity_special_area_p(entity e)
void fprint_functional(FILE *fd, functional f)
This function is called from c_parse() via ResetCurrentModule() and fprint_environment()
entity FindEntity(const char *package, const char *name)
Retrieve an entity from its package/module name and its local name.
const char * entity_local_name(entity e)
entity_local_name modified so that it does not core when used in vect_fprint, since someone thought t...
entity FindOrCreateEntity(const char *package, const char *local_name)
Problem: A functional global entity may be referenced without parenthesis or CALL keyword in a functi...
bool intrinsic_entity_p(entity e)
entity local_name_to_top_level_entity(const char *n)
This function try to find a top-level entity from a local name.
code entity_code(entity e)
entity FindOrCreateTopLevelEntity(const char *name)
Return a top-level entity.
bool entity_function_p(entity e)
void sort_list_of_entities(list l)
sorted in place.
const char * module_local_name(entity e)
Returns the module local user name.
bool entity_blockdata_p(entity e)
bool entity_module_p(entity e)
bool top_level_entity_p(entity e)
Check if the scope of entity e is global.
entity CreateIntrinsic(string name)
this function does not create an intrinsic function because they must all be created beforehand by th...
bool entity_common_p(entity e)
expression make_call_expression(entity e, list l)
Build an expression that call an function entity with an argument list.
expression int_to_expression(_int i)
transform an int into an expression and generate the corresponding entity if necessary; it is not cle...
expression MakeNullaryCall(entity f)
Creates a call expression to a function with zero arguments.
bool formal_label_replacement_p(entity)
bool SizeOfArray(entity, int *)
This function computes the total size of a variable in bytes, ie.
basic MakeBasic(int)
END_EOLE.
int ExpressionToInt(expression)
this function computes the value of an integer constant expression and returns it to the calling func...
int basic_type_size(basic)
See also SizeOfElements()
bool entity_scalar_p(entity)
The concrete type of e is a scalar type.
bool variable_entity_p(entity)
variable.c
void AddEntityToDeclarations(entity, entity)
END_EOLE.
int SizeOfIthDimension(entity, int)
this function returns the size of the ith dimension of a variable e.
bool type_equal_p(type, type)
bool variable_in_module_p(entity, entity)
This test can only be applied to variables, not to functions, subroutines or commons visible from a m...
void discard_module_declaration_text(entity)
Discard the decls_text string of the module code to make the prettyprinter ignoring the textual decla...
bool basic_equal_p(basic, basic)
bool formal_parameter_p(entity)
type MakeTypeVariable(basic, cons *)
BEGIN_EOLE.
#define type_functional_p(x)
#define value_undefined_p(x)
#define functional_result(x)
#define value_constant(x)
#define reference_variable(x)
#define type_functional(x)
#define value_unknown_p(x)
#define dimension_lower(x)
#define entity_storage(x)
#define code_declarations(x)
#define range_increment(x)
#define EXPRESSION(x)
EXPRESSION.
#define type_undefined_p(x)
#define entity_undefined_p(x)
#define constant_int_p(x)
#define expression_undefined
#define functional_parameters(x)
#define code_initializations(x)
#define sequence_statements(x)
#define reference_indices(x)
#define constant_call_p(x)
#define variable_undefined_p(x)
#define variable_dimensions(x)
#define storage_return_p(x)
#define type_variable_p(x)
#define storage_undefined_p(x)
#define entity_domain
newgen_syntax_domain_defined
#define variable_basic(x)
#define statement_undefined
#define STATEMENT(x)
STATEMENT.
#define storage_undefined
#define entity_initial(x)
int fprintf()
test sc_min : ce test s'appelle par : programme fichier1.data fichier2.data ...
The structure used to build lists in NewGen.
#define Warning(f, m)
extern char * getenv();
int line_b_I
Indicates where the current instruction (in fact statement) starts and ends in the input file and giv...
bool ParserError(const char *f, const char *m)
const char * CurrentPackage
the name of the current package, i.e.