#include "constants.h"
#include "parser_private.h"

Include dependency graph for syntax.h:

This graph shows which files directly or indirectly include this file:

Macros
#define	START_COMMENT_LINE "CcDd*!#\n"
	Warning! Do not modify this file that is automatically generated! More...

#define	HASH_SIZE 1013
	definition of implementation dependent constants More...

#define	FORMATLENGTH (4096)

#define	LOCAL static

#define	abs(v) (((v) < 0) ? -(v) : (v))

#define	Warning(f, m) (user_warning(f,"Warning between lines %d and %d\n%s\n",line_b_I,line_e_I,m) )
	extern char * getenv(); More...

#define	FatalError(f, m) (pips_internal_error("Fatal error between lines %d and %d\n%s\n",line_b_I,line_e_I,m))

Functions
int	syn_lex ()

void	syn_reset_lex ()

int	syn_parse ()

void	syn_error (const char *)

int	SafeSizeOfArray (entity)
	cproto-generated files More...

void	InitAreas (void)

void	save_all_entities (void)
	functions for the SAVE declaration More...

void	SaveEntity (entity)
	These two functions transform a dynamic variable into a static one. More...

void	MakeVariableStatic (entity, bool)

void	ProcessSave (entity)

void	save_initialized_variable (entity)

void	SaveCommon (entity)
	this function transforms a dynamic common into a static one. More...

void	PrintData (cons , cons )
	a debugging function, just in case ... More...

void	AnalyzeData (list, list)
	this function scans at the same time a list of datavar and a list of dataval. More...

void	MakeDataStatement (list, list)
	Receives as first input an implicit list of references, including implicit DO, and as second input an list of value using pseudo-intrinsic REPEAT_VALUE() to replicate values. More...

void	DeclarePointer (entity, entity, list)

void	DeclareVariable (entity, type, list, storage, value)
	void DeclareVariable(e, t, d, s, v): update entity e description as declaration statements are encountered. More...

void	DeclareIntrinsic (entity)
	Intrinsic e is used in the current module. More...

bool	fortran_relevant_area_entity_p (entity)
	These tests are needed to check area consistency when dumping or printing a symbol table. More...

void	initialize_common_size_map (void)

void	reset_common_size_map (void)

void	reset_common_size_map_on_error (void)

bool	common_to_defined_size_p (entity)

size_t	common_to_size (entity)

void	set_common_to_size (entity, size_t)

void	update_common_to_size (entity, size_t)

entity	MakeCommon (entity)
	MakeCommon: This function creates a common block. More...

entity	NameToCommon (string)

void	AddVariableToCommon (entity, entity)
	This function adds a variable v to a common block c. More...

int	CurrentOffsetOfArea (entity, entity)

void	update_common_sizes (void)

void	InitImplicit (void)
	this function initializes the data structure used to compute implicit types More...

void	cr_implicit (tag, int, int, int)
	this function updates the data structure used to compute implicit types. More...

type	ImplicitType (entity)
	This function computes the Fortran implicit type of entity e. More...

bool	implicit_type_p (entity)
	This function checks that entity e has an undefined or an implicit type which can be superseded by another declaration. More...

void	retype_formal_parameters (void)
	If an IMPLICIT statement is encountered, it must be applied to the formal parameters, and, if the current module is a function, to the function result type and to the variable used internally when a value is assigned to the function (see MakeCurrentFunction) More...

type	MakeFortranType (tag, value)
	this function creates a type that represents a fortran type. More...

int	OffsetOfReference (reference)
	This function computes the numerical offset of a variable element from the begining of the variable. More...

int	ValueOfIthLowerBound (entity, int)
	this function returns the size of the ith lower bound of a variable e. More...

int	SizeOfRange (range)
	This function computes the size of a range, ie. More...

int	IsIntegerScalar (entity)
	FI: should be moved in ri-util; this function returns true if e is a zero dimension variable of basic type integer. More...

void	update_user_common_layouts (entity)
	Check... More...

bool	update_common_layout (entity, entity)
	(Re)compute offests of all variables allocated in common c from module m and update (if necessary) the size of common c for the whole program or set of modules in the current workspace. More...

entity	SafeFindOrCreateEntity (const char , const char )
	Problem: A functional global entity may be referenced without parenthesis or CALL keyword in a function or subroutine call as functional parameter. More...

void	add_entity_to_declarations (string, string, enum basic_utype tag, void *)
	FI: I do not understand the naming here, or the parameter. More...

entity	MakeParameter (entity, expression)
	lint More...

expression	MakeImpliedDo (syntax, range, cons *)
	expressions from input output lists might contain implied do loops. More...

expression	loop_to_implieddo (loop)

syntax	MakeAtom (entity, cons *, expression, expression, int)
	MakeAtom: this function creates a syntax, ie. More...

cons *	MakeIoList (cons *)
	This function takes a list of io elements (i, j, t(i,j)), and returns the same list, with a cons cell pointing to a character constant expression 'IOLIST=' before each element of the original list. More...

list	FortranExpressionList (list)
	Make sure that no call to implied do is in l. More...

expression	MakeFortranBinaryCall (entity, expression, expression)

expression	MakeFortranUnaryCall (entity, expression)

syntax	CheckLeftHandSide (syntax)
	If a left hand side is a call, it should be a substring operator or a macro. More...

entity	make_Fortran_constant_entity (string, tag, size_t)

void	ResetChains (void)
	undefine chains between two successives calls to parser More...

void	SetChains (void)
	initialize chains before each call to the parser More...

atom	MakeEquivAtom (syntax)
	this function creates an atom of an equivalence chain. More...

void	StoreEquivChain (chain)
	This function is called when an equivalence chain has been completely parsed. More...

void	ComputeEquivalences (void)
	This function merges all the equivalence chains to take into account equivalences due to transitivity. More...

int	AddOrMergeChain (chain)
	this function adds a chain ct to the set of equivalences. More...

int	ChainIntersection (cons , cons )
	this function returns true if the there is a variable that occurs in both atom lists. More...

cons *	MergeTwoChains (cons , cons )
	this function merges two equivalence chains whose intersection is not empty, ie. More...

void	PrintChains (equivalences)
	two debugging functions, just in case ... More...

void	PrintChain (chain)

bool	entity_in_equivalence_chains_p (entity)

bool	entity_in_equivalence_chain_p (entity, chain)

void	ComputeAddresses (void)
	This function computes an address for every variable. More...

void	SaveChains (void)
	Initialize the shared fields of aliased variables. More...

void	reset_current_label_string (void)

string	get_current_label_string (void)

void	set_current_label_string (string)

bool	empty_current_label_string_p (void)

bool	ParserError (const char , const char )

void	BeginingOfParsing (void)
	this function is called for each new file (FI: once?) FI: I do not understand how this works. More...

bool	hpfc_parser (const string)
	parser for HPFC. More...

bool	parser (const string)

void	init_parser_properties (void)

void	init_ghost_variable_entities (void)
	procedure.c More...

void	substitute_ghost_variable_in_expression (expression, entity, entity)

void	substitute_ghost_variable_in_statement (statement, entity, entity)

void	remove_ghost_variable_entities (bool)

void	add_ghost_variable_entity (entity)

void	reify_ghost_variable_entity (entity)
	It is possible to change one's mind and effectively use an entity which was previously assumed useless. More...

bool	ghost_variable_entity_p (entity)

void	BeginingOfProcedure (void)
	this function is called each time a new procedure is encountered. More...

void	update_called_modules (entity)

void	remove_from_called_modules (entity)
	macros are added, although they should not have been. More...

void	AbortOfProcedure (void)

void	EndOfProcedure (void)
	This function is called when the parsing of a procedure is completed. More...

void	UpdateFunctionalType (entity, list)
	This function analyzes the CurrentFunction formal parameter list to determine the CurrentFunction functional type. More...

void	remove_module_entity (entity)

void	MakeCurrentFunction (type, int, const char *, list)
	this function creates one entity cf that represents the Fortran function f being analyzed. More...

void	ResetEntries (void)

void	AbortEntries (void)

bool	EmptyEntryListsP (void)

void	AddEntryLabel (entity)

void	AddEntryTarget (statement)

void	AddEntryEntity (entity)

void	AddEffectiveFormalParameter (entity)
	Keep track of the formal parameters for the current module. More...

bool	IsEffectiveFormalParameterP (entity)

entity	SafeLocalToGlobal (entity, type)
	A local entity might have been created but found out later to be global, depending on the order of declaration statements (see MakeExternalFunction()). More...

type	MakeResultType (entity, type)
	The result type of a function may be carried by e, by r or be implicit. More...

entity	LocalToGlobal (entity)

instruction	MakeEntry (entity, list)
	An ENTRY statement is substituted by a labelled continue. More...

void	ProcessEntries (void)

entity	NameToFunctionalEntity (string)

void	TypeFunctionalEntity (entity, type)

entity	MakeExternalFunction (entity, type)

entity	DeclareExternalFunction (entity)

void	MakeFormalParameter (entity, entity, int)
	This function transforms an untyped entity into a formal parameter. More...

void	ScanFormalParameters (entity, list)
	this function scans the formal parameter list. More...

void	UpdateFormalStorages (entity, list)
	this function check and set if necessary the storage of formal parameters in lfp. More...

void	append_data_current_stmt_buffer_to_declarations (void)

void	parser_reset_all_reader_buffers (void)

void	init_parser_reader_properties (void)

int	syn_wrap (void)

void	ScanNewFile (void)
	La fonction a appeler pour l'analyse d'un nouveau fichier. More...

int	IsCapKeyword (char *)
	Fonction appelee par sslex sur la reduction de la regle de reconnaissance des mot clefs. More...

int	PipsGetc (FILE *)
	Routine de lecture pour l'analyseur lexical, lex ou flex. More...

int	GetChar (FILE *)
	Routine de lecture physique. More...

int	ReadLine (FILE *)
	All physical lines of a statement are put together in a unique buffer called "line_buffer". More...

int	ReadStmt (FILE *)
	regroupement des lignes du statement en une unique ligne sans continuation More...

void	CheckParenthesis (void)

int	FindDoWhile (void)
	This function is redundant with FindDo() but much easier to understand. More...

int	FindDo (void)

int	FindImplicit (void)

int	FindIfArith (void)

void	FindIf (void)

void	FindAutre (void)

int	FindAssign (void)

void	FindPoints (void)

size_t	FindProfZero (int)

size_t	FindMatchingPar (size_t)

int	StmtEqualString (char *, int)

int	CapitalizeStmt (char[], int)

int	NeedKeyword (void)

void	dump_current_statement (void)

int	get_statement_number (void)
	eturn the line number of the statement being parsed More...

void	parser_reset_StmtHeap_buffer (void)
	statement.c More...

statement	LabelToStmt (string)
	this functions looks up in table StmtHeap for the statement s whose label is l. More...

void	CheckAndInitializeStmt (void)
	this function looks for undefined labels. More...

void	NewStmt (entity, statement)
	this function stores a new association in table StmtHeap: the label of statement s is e. More...

void	ResetBlockStack (void)

bool	IsBlockStackEmpty (void)

bool	IsBlockStackFull (void)

void	PushBlock (instruction, string)

instruction	PopBlock (void)

entity	MakeLabel (const char *)

statement	MakeNewLabelledStatement (entity, instruction)

statement	ReuseLabelledStatement (statement, instruction)

statement	MakeStatement (entity, instruction)
	This function makes a statement. More...

void	LinkInstToCurrentBlock (instruction, bool)
	this function links the instruction i to the current block of statements. More...

instruction	MakeEmptyInstructionBlock (void)
	this function creates an empty block More...

instruction	MakeZeroOrOneArgCallInst (char *, expression)
	this function creates a simple Fortran statement such as RETURN, CONTINUE, ... More...

instruction	MakeGotoInst (string)
	this function creates a goto instruction. More...

instruction	make_goto_instruction (entity)
	In a "go to" instruction, the label does not appear explictly. More...

instruction	MakeComputedGotoInst (list, expression)

instruction	MakeAssignedGotoInst (list, entity)

instruction	MakeAssignedOrComputedGotoInst (list, expression, bool)

instruction	MakeAssignInst (syntax, expression)
	this function creates an affectation statement. More...

void	update_functional_type_result (entity, type)
	Update of the type returned by function f. More...

void	update_functional_type_with_actual_arguments (entity, list)

instruction	MakeCallInst (entity, cons *)
	this function creates a call statement. More...

void	MakeDoInst (syntax, range, string)
	this function creates a do loop statement. More...

void	MakeWhileDoInst (expression, string)
	This function creates a while do loop statement. More...

expression	fix_if_condition (expression)

instruction	MakeLogicalIfInst (expression, instruction)
	this function creates a logical if statement. More...

instruction	MakeArithmIfInst (expression, string, string, string)
	this function transforms an arithmetic if statement into a set of regular tests. More...

void	MakeBlockIfInst (expression, int)
	this function and the two next ones create a block if statement. More...

int	MakeElseInst (bool)
	This function is used to handle either an ELSE or an ELSEIF construct. More...

void	MakeEndifInst (void)

void	MakeEnddoInst (void)

string	NameOfToken (int)

statement	make_check_io_statement (string, expression, entity)
	Generate a test to jump to l if flag f is TRUE Used to implement control effects of IO's due to ERR= and END=. More...

instruction	MakeIoInstA (int, list, list)
	this function creates an IO statement. More...

instruction	MakeIoInstB (int, expression, expression, expression, expression)
	this function creates a BUFFER IN or BUFFER OUT io statement. More...

instruction	MakeSimpleIoInst1 (int, expression unit)

instruction	MakeSimpleIoInst2 (int, expression, list)

void	reset_first_statement (void)

void	set_first_format_statement (void)

bool	first_executable_statement_seen (void)

bool	first_format_statement_seen (void)

void	check_in_declarations (void)

void	check_first_statement (void)
	This function is called each time an executable statement is encountered but is effective the first time only. More...

void	SubstituteAlternateReturns (const char *)
	return.c More...

bool	SubstituteAlternateReturnsP (void)

entity	GetReturnCodeVariable (void)

bool	ReturnCodeVariableP (entity)

void	ResetReturnCodeVariable (void)

bool	uses_alternate_return_p (void)

void	uses_alternate_return (bool)

void	set_current_number_of_alternate_returns (void)

void	reset_current_number_of_alternate_returns (void)

int	get_current_number_of_alternate_returns (void)

list	add_formal_return_code (list)
	Update the formal and actual parameter lists by adding the return code variable as last argument. More...

list	add_actual_return_code (list)

void	add_alternate_return (string)

list	get_alternate_returns (void)

void	set_alternate_returns (void)

void	reset_alternate_returns (void)

void	soft_reset_alternate_returns (void)
	ParserError() cannot guess if it has been performed or not, because it is reinitialized before and after each call statement. More...

instruction	generate_return_code_checks (list)

instruction	MakeReturn (expression)

void	GenerateReturn (void)
	Generate a unique call to RETURN per module. More...

void	print_malloc_info (FILE *)
	malloc-info.c More...

void	print_full_malloc_info (FILE *)

void	parser_init_macros_support (void)
	macros.c More...

void	parser_close_macros_support (void)

bool	parser_entity_macro_p (entity)

void	parser_add_a_macro (call, expression)

void	reset_substitute_expression_in_expression (void)

void	parser_macro_expansion (expression)

void	parser_substitute_all_macros (statement)

void	parser_substitute_all_macros_in_expression (expression)

void	syn_restart (FILE *)

void	syn_pop_buffer_state (void)

int	syn_get_lineno (void)

FILE *	syn_get_in (void)

FILE *	syn_get_out (void)

int	syn_get_leng (void)

char *	syn_get_text (void)

void	syn_set_lineno (int)

void	syn_set_in (FILE *)

void	syn_set_out (FILE *)

int	syn_get_debug (void)

void	syn_set_debug (int)

int	syn_lex_destroy (void)

void *	syn_alloc (yy_size_t)

void *	syn_realloc (void *, yy_size_t)

void	syn_free (void *)

Variables
FILE *	syn_in
	lex yacc interface More...

entity	DynamicArea
	These global variables are declared in ri-util/util.c. More...

entity	StaticArea

entity	HeapArea

entity	StackArea

entity	AllocatableArea

char	vcid_syntax_expression []
	expression.c More...

char	vcid_syntax_equivalence []
	equivalence.c More...

char *	CurrentFN
	parser.c More...

cons *	FormalParameters
	the current function More...

const char *	CurrentPackage
	the name of the current package, i.e. More...

int	line_b_I
	Indicates where the current instruction (in fact statement) starts and ends in the input file and gives its label. More...

int	line_e_I

int	line_b_C

int	line_e_C

char	lab_I [6]

char	FormatValue [(4096)]
	a string that will contain the value of the format in case of format statement More...

bool	InParserError
	Parser error handling. More...

char *	Comm
	reader.c More...

char *	PrevComm

char *	CurrComm

int	iComm

int	iPrevComm

int	iCurrComm

int	ici
	syn_yacc.c More...

type	CurrentType
	to count control specifications in IO statements More...

intptr_t	CurrentTypeSize
	the type in a type or dimension or common statement More...

int	syn_char

int	syn_nerrs

int	syn_leng
	scanner.c More...

FILE *	syn_out

int	syn_lineno

int	syn__flex_debug

char *	syn_text

Macro Definition Documentation

◆ abs

#define abs ( v ) (((v) < 0) ? -(v) : (v))

Definition at line 56 of file syntax.h.

◆ FatalError

#define FatalError	(	f,
		m
	)	(pips_internal_error("Fatal error between lines %d and %d\n%s\n",line_b_I,line_e_I,m))

Definition at line 64 of file syntax.h.

◆ FORMATLENGTH

#define FORMATLENGTH (4096)

Definition at line 52 of file syntax.h.

◆ HASH_SIZE

#define HASH_SIZE 1013

definition of implementation dependent constants

Definition at line 51 of file syntax.h.

◆ LOCAL

#define LOCAL static

Definition at line 53 of file syntax.h.

◆ START_COMMENT_LINE

#define START_COMMENT_LINE "CcDd*!#\n"

Warning! Do not modify this file that is automatically generated!

Modify src/Libs/syntax/syntax-local.h instead, to add your own modifications. header file built by cproto syntax-local.h Legal characters to start a comment line

'
' is added to cope with empty lines Empty lines with SPACE and TAB characters are be preprocessed and reduced to an empty line by GetChar().

Definition at line 38 of file syntax.h.

◆ Warning

#define Warning	(	f,
		m
	)	(user_warning(f,"Warning between lines %d and %d\n%s\n",line_b_I,line_e_I,m) )

extern char * getenv();

Definition at line 61 of file syntax.h.

Function Documentation

◆ AbortEntries()

void AbortEntries ( void )

Useless entities should be reset

the current module statement is used when processing entries

Definition at line 1473 of file procedure.c.

 {
     /* Useless entities should be reset */
  
     MAP(ENTITY, el, {
         free_entity(el);
     }, entry_labels);
     gen_free_list(entry_labels);
     entry_labels = NIL;
  
     MAP(ENTITY, et, {
         free_entity(et);
     }, entry_targets);
     gen_free_list(entry_targets);
     entry_targets = NIL;
  
     MAP(ENTITY, ee, {
         CleanLocalEntities(ee);
         free_entity(ee);
     }, entry_entities);
     gen_free_list(entry_entities);
     entry_entities = NIL;
  
     MAP(ENTITY, efp, {
         free_entity(efp);
     }, entry_targets);
     gen_free_list(effective_formal_parameters);
     effective_formal_parameters = NIL;
  
     /* the current module statement is used when processing entries */
     error_reset_current_module_statement();
 }

References CleanLocalEntities(), effective_formal_parameters, ENTITY, entry_entities, entry_labels, entry_targets, error_reset_current_module_statement(), free_entity(), gen_free_list(), MAP, and NIL.

Referenced by ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ AbortOfProcedure()

void AbortOfProcedure ( void )

get rid of ghost variable entities

Definition at line 386 of file procedure.c.

 {
     /* get rid of ghost variable entities */
     if (!list_undefined_p(ghost_variable_entities))
         remove_ghost_variable_entities(false);
  
     (void) ResetBlockStack() ;
 }

References ghost_variable_entities, list_undefined_p, remove_ghost_variable_entities(), and ResetBlockStack().

Referenced by ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ add_actual_return_code()

list add_actual_return_code ( list apl )

Parameters

apl pl

Definition at line 222 of file return.c.

 {
   list new_apl = apl;
  
   if(substitute_rc_p && !hide_rc_p && !ENDP(get_alternate_returns())) {
     entity frc = GetFullyDefinedReturnCodeVariable();
  
     new_apl = gen_nconc(apl, CONS(EXPRESSION, entity_to_expression(frc), NIL));
   }
  
   return new_apl;
 }

References CONS, ENDP, entity_to_expression(), EXPRESSION, gen_nconc(), get_alternate_returns(), GetFullyDefinedReturnCodeVariable(), hide_rc_p, NIL, and substitute_rc_p.

Referenced by MakeCallInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ add_alternate_return()

void add_alternate_return ( string label_name )

Parameters

label_name abel_name

Definition at line 242 of file return.c.

 {
     entity l = entity_undefined;
  
     if(substitute_rc_p) {
         l = MakeLabel(label_name);
         alternate_returns = arguments_add_entity(alternate_returns, l);
     }
     else {
         pips_user_warning("Lines %d-%d: Alternate return towards label %s not supported. "
                           "Actual label argument internally substituted by a character string.\n",
                           line_b_I, line_e_I, label_name);
     }
 }

References alternate_returns, arguments_add_entity(), entity_undefined, line_b_I, line_e_I, MakeLabel(), pips_user_warning, and substitute_rc_p.

Here is the call graph for this function:

◆ add_entity_to_declarations()

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.

The name of the new variable must be a global name, whereas the name of the area is a local name. And the area does not have to be the stack area...

Why is this variable called "stack area" when it can be any area?

Parameters

name	ame
area_name	rea_name
val	al

Definition at line 1969 of file declaration.c.

                                                                             {
   entity new_e = FindOrCreateTopLevelEntity (name);
   basic b = make_basic (tag, val);
   variable v = make_variable (b, NIL, NIL);
   entity_type (new_e) = make_type_variable (v);
   const char* module_name = module_local_name(get_current_module_entity ());
   /* Why is this variable called "stack area" when it can be any area? */
   entity stack_area = FindEntity(module_name, area_name);
   storage s = make_storage_ram(make_ram(get_current_module_entity (),
                                         stack_area,
                                         CurrentOffsetOfArea(stack_area, new_e),
                                         NIL));
   entity_storage (new_e) = s;
   value initial = make_value_unknown ();
   entity_initial (new_e) = initial;
   AddEntityToDeclarations(new_e, get_current_module_entity ());
   discard_module_declaration_text(get_current_module_entity ());
 }

References AddEntityToDeclarations(), CurrentOffsetOfArea(), discard_module_declaration_text(), entity_initial, entity_storage, entity_type, FindEntity(), FindOrCreateTopLevelEntity(), get_current_module_entity(), make_basic(), make_ram(), make_storage_ram(), make_type_variable(), make_value_unknown(), make_variable(), module_local_name(), module_name(), and NIL.

Here is the call graph for this function:

◆ add_formal_return_code()

list add_formal_return_code ( list fpl )

Update the formal and actual parameter lists by adding the return code variable as last argument.

To avoid an explicit check in gram.y which is large enough, the additions are conditional to the alternate return substitution.

Type, storage and initial value are set up later in MakeFormalParameter()

Parameters

fpl pl

Definition at line 209 of file return.c.

 {
     list new_fpl = fpl;
  
     if(uses_alternate_return_p() && !hide_rc_p && substitute_rc_p) {
         entity frc = GetReturnCodeVariable();
  
         /* Type, storage and initial value are set up later in MakeFormalParameter() */
         new_fpl = gen_nconc(fpl, CONS(ENTITY, frc, NIL));
     }
     return new_fpl;
 }

References CONS, ENTITY, gen_nconc(), GetReturnCodeVariable(), hide_rc_p, NIL, substitute_rc_p, and uses_alternate_return_p().

Referenced by MakeCurrentFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ add_ghost_variable_entity()

void add_ghost_variable_entity ( entity e )

Definition at line 275 of file procedure.c.

 {
     pips_assert("defined list", !list_undefined_p(ghost_variable_entities));
     ghost_variable_entities = arguments_add_entity(ghost_variable_entities, e);
 }

References arguments_add_entity(), ghost_variable_entities, list_undefined_p, and pips_assert.

Referenced by SafeLocalToGlobal().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ AddEffectiveFormalParameter()

void AddEffectiveFormalParameter ( entity f )

Keep track of the formal parameters for the current module.

Definition at line 1529 of file procedure.c.

 {
     effective_formal_parameters = arguments_add_entity(effective_formal_parameters, f);
 }

References arguments_add_entity(), effective_formal_parameters, and f().

Referenced by MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ AddEntryEntity()

void AddEntryEntity ( entity e )

Definition at line 1523 of file procedure.c.

 {
     entry_entities = arguments_add_entity(entry_entities, e);
 }

References arguments_add_entity(), and entry_entities.

Referenced by MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ AddEntryLabel()

void AddEntryLabel ( entity l )

Definition at line 1513 of file procedure.c.

 {
     entry_labels = arguments_add_entity(entry_labels, l);
 }

References arguments_add_entity(), and entry_labels.

Referenced by MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ AddEntryTarget()

void AddEntryTarget ( statement s )

Definition at line 1518 of file procedure.c.

 {
     entry_targets = gen_nconc(entry_targets, CONS(STATEMENT, s, NIL));
 }

References CONS, entry_targets, gen_nconc(), NIL, and STATEMENT.

Referenced by MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ AddOrMergeChain()

int AddOrMergeChain ( chain ct )

this function adds a chain ct to the set of equivalences.

if the intersection with all other chains is empty, ct is just added to the set. Otherwise ct is merged with the chain that intersects ct.

Parameters

ct t

Definition at line 269 of file equivalence.c.

 {
     cons *pcl, *pcf, *pct;
  
     pct = chain_atoms(ct);
     chain_atoms(ct) = NIL;
     
     for (pcl = equivalences_chains(FinalEquivSet); pcl != NIL; pcl=CDR(pcl)) {
         chain cf;
  
         cf = CHAIN(CAR(pcl));
         pcf = chain_atoms(cf);
  
         if (ChainIntersection(pct, pcf)) {
             chain_atoms(cf) = MergeTwoChains(pct, pcf);
             return(EQUIMERGE);
         }
     }
  
     equivalences_chains(FinalEquivSet) =
             CONS(CHAIN, make_chain(pct), 
                  equivalences_chains(FinalEquivSet));
  
     return(EQUIADD);
 }

References CAR, CDR, CHAIN, chain_atoms, ChainIntersection(), CONS, EQUIADD, EQUIMERGE, equivalences_chains, FinalEquivSet, make_chain(), MergeTwoChains(), and NIL.

Referenced by ComputeEquivalences().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ AddVariableToCommon()

void AddVariableToCommon	(	entity	c,
		entity	v
	)

This function adds a variable v to a common block c.

v's storage must be undefined.

c's size used to be indirectly updated by CurrentOffsetOfArea() but this is meaningless because v's type and dimensions are unknown. The layouts of commons are updated later by update_common_sizes() called from EndOfProcedure().

Definition at line 1108 of file declaration.c.

 {
     entity new_v = entity_undefined;
     type ct = entity_type(c);
     area ca = type_area(ct);
  
     if (entity_storage(v) != storage_undefined) {
         if(intrinsic_entity_p(v)) {
             new_v = FindOrCreateEntity(get_current_module_name(),
                                               entity_local_name(v));
             user_warning("AddVariableToCommon",
                          "Intrinsic %s overloaded by variable %s between line %d and %d\n",
                          entity_name(v), entity_local_name(v), line_b_I, line_e_I);
             if(type_undefined_p(entity_type(new_v))) {
                 entity_type(new_v) = ImplicitType(new_v);
             }
         }
         else if(storage_rom_p(entity_storage(v))) {
             user_warning("AddVariableToCommon",
                          "Module or parameter %s declared in common %s between line %d and %d\n",
                          entity_local_name(v), module_local_name(c), line_b_I, line_e_I);
             ParserError("AddVariableToCommon",
                         "Ill. decl. of function or subroutine in a common\n");
         }
         else {
           entity m = get_current_module_entity();
  
           if(value_defined_p(entity_initial(v)) && !entity_blockdata_p(m)) {
               pips_user_warning("Variable %s has conflicting requirements"
                                 " for storage (e.g. it appears in a DATA"
                                 " and in a COMMON statement in a non "
                                 "BLOCKDATA module\n", entity_local_name(v));
               ParserError("AddVariableToCommon", "Storage conflict\n");
             }
             else {
               if(entity_blockdata_p(m)) {
                 pips_user_warning("ANSI extension: specification statements"
                                   " after DATA statement for variable %s\n",
                                   entity_local_name(v));
                 ParserError("AddVariableToCommon", "Storage conflict\n");
               }
               else {
                 user_warning("AddVariableToCommon",
                              "Storage tag=%d for entity %s\n",
                              storage_tag(entity_storage(v)), entity_name(v));
                 FatalError("AddVariableToCommon", "storage already defined\n");
               }
             }
         }
     }
     else {
         new_v = v;
     }
  
     DeclareVariable(new_v, 
                     type_undefined, 
                     NIL, 
                     (make_storage(is_storage_ram,
                                   (make_ram(get_current_module_entity(), c, 
                                             0, // UNKNOWN_RAM_OFFSET?
                                             NIL)))),
                     value_undefined);
  
     area_layout(ca) = gen_nconc(area_layout(ca), CONS(ENTITY, v, NIL));
 }

References area_layout, CONS, DeclareVariable(), ENTITY, entity_blockdata_p(), entity_initial, entity_local_name(), entity_name, entity_storage, entity_type, entity_undefined, FatalError, FindOrCreateEntity(), gen_nconc(), get_current_module_entity(), get_current_module_name(), ImplicitType(), intrinsic_entity_p(), is_storage_ram, line_b_I, line_e_I, make_ram(), make_storage(), module_local_name(), NIL, ParserError(), pips_user_warning, storage_rom_p, storage_tag, storage_undefined, type_area, type_undefined, type_undefined_p, user_warning, value_defined_p(), and value_undefined.

Here is the call graph for this function:

◆ AnalyzeData()

void AnalyzeData	(	list	ldvr,
		list	ldvl
	)

this function scans at the same time a list of datavar and a list of dataval.

it tries to match datavar to dataval and to compute initial values for zero dimension variable of basic type integer.

ldvr is a list of datavar.

ldvl is a list of dataval.

FI: this assertion must be usually wrong! pips_assert("AnalyseData", gen_length(ldvr) == gen_length(ldvl));

Variable is in static area or in a user declared common

Variable must be in a user declared common

Variable must be in static area

entity e initial field is set here with the data information.

if (entity_defined_p(e))

Parameters

ldvr	dvr
ldvl	dvl

Definition at line 352 of file declaration.c.

 {
     list pcr, pcl;
     dataval dvl;
  
     /* FI: this assertion must be usually wrong!
      * pips_assert("AnalyseData", gen_length(ldvr) == gen_length(ldvl));
      */
  
     pips_debug(8, "number of reference groups: %td\n", gen_length(ldvr));
  
     pcl = ldvl;
     dvl = DATAVAL(CAR(pcl));
     for (pcr = ldvr; pcr != NIL && pcl != NIL; pcr = CDR(pcr)) 
     {
       datavar dvr = DATAVAR(CAR(pcr));
       entity e = datavar_variable(dvr);
       int i = datavar_nbelements(dvr);
       
       if (!entity_undefined_p(e))
       {
  
       pips_debug(8, "Storage for entity %s must be static or made static\n",
                  entity_name(e));
       
       if(storage_undefined_p(entity_storage(e))) {
         entity_storage(e) =
           make_storage(is_storage_ram,
                        (make_ram(get_current_module_entity(),
                                  StaticArea, 
                                  UNKNOWN_RAM_OFFSET,
                                  NIL)));
       }
       else if(storage_ram_p(entity_storage(e))) {
         entity s = ram_section(storage_ram(entity_storage(e)));
         entity m = get_current_module_entity();
         
         if(dynamic_area_p(s)) {
           if(entity_blockdata_p(m)) {
             pips_user_warning
               ("Variable %s is declared dynamic in a BLOCKDATA\n",
                entity_local_name(e));
             ParserError("AnalyzeData",
                         "No dynamic variables in BLOCKDATA\n");
           }
           else {
             SaveEntity(e);
           }
         }
         else {
           /* Variable is in static area or in a user declared common */
           if(entity_blockdata_p(m)) {
             /* Variable must be in a user declared common */
             if(static_area_p(s)) {
               pips_user_warning
                 ("DATA for variable %s declared is impossible:"
                  " it should be declared in a COMMON instead\n",
                  entity_local_name(e));
               ParserError("AnalyzeData",
                           "Improper DATA declaration in BLOCKDATA");
             }
           }
           else {
             /* Variable must be in static area */
             if(!static_area_p(s)) {
               pips_user_warning
                 ("DATA for variable %s declared in COMMON %s:"
                  " not standard compliant,"
                  " use a BLOCKDATA\n",
                  entity_local_name(e), module_local_name(s));
               if(!get_bool_property("PARSER_ACCEPT_ANSI_EXTENSIONS")) {
                 ParserError("AnalyzeData",
                             "Improper DATA declaration, use a BLOCKDATA"
                             " or set property PARSER_ACCEPT_ANSI_EXTENSIONS");
               }
             }
           }
         }
       }
       else {
         user_warning("AnalyzeData",
                      "DATA initialization for non RAM variable %s "
                      "(storage tag = %d)\n",
                      entity_name(e), storage_tag(entity_storage(e)));
         ParserError("AnalyzeData", 
                     "DATA statement initializes non RAM variable\n");
       }
       
       pips_debug(8, "needs %d elements for entity %s\n", 
                  i, entity_name(e));
       
       pips_assert("AnalyzeData", dataval_nboccurrences(dvl) > 0);
       
       /* entity e initial field is set here with the data information. 
        */
       if (entity_scalar_p(e))
       {
         constant cst = dataval_constant(dvl);
  
         pips_assert("AnalyzeData", i == 1);
         
         if (constant_int_p(cst) || constant_call_p(cst)) 
         {
           if(value_undefined_p(entity_initial(e)) ||
              value_unknown_p(entity_initial(e))) 
           {
             value old = entity_initial(e);
             entity_initial(e) = make_value(is_value_constant, 
                                            copy_constant(cst));
             free_value(old);
           }
           else 
           {
             pips_user_warning("Conflicting initial values for variable %s\n",
                               entity_local_name(e));
             ParserError("AnalyzeData", "Too many initial values");
           }
         }
         else 
         {
           Warning("AnalyzeData", 
                   "Integer scalar variable initialized "
                   "with non-integer constant");
         }
       }
  
       } /* if (entity_defined_p(e)) */
       
       while (i > 0 && pcl != NIL) 
       {
         if (i <= dataval_nboccurrences(dvl)) {
           pips_debug(8, "uses %d values out of %td\n",
                      i, dataval_nboccurrences(dvl));
           dataval_nboccurrences(dvl) -= i;
           i = 0;
         }
         else {
           pips_debug(8, "satisfies %td references out of %d\n",
                      dataval_nboccurrences(dvl), i);
           i -= dataval_nboccurrences(dvl);
           dataval_nboccurrences(dvl) = 0;
         }
         
         if (dataval_nboccurrences(dvl) == 0) {
           if ((pcl = CDR(pcl)) != NIL) {
             dvl = DATAVAL(CAR(pcl));
             
             pips_debug(8, "use next dataval\n");
           }
         }
         datavar_nbelements(dvr) = i;
       }
     }
     
     if (pcl != NIL) {
       Warning("AnalyzeData", "too many initializers\n");
     }
     
     if (pcr != NIL && 
         (datavar_nbelements(DATAVAR(CAR(pcr))) != 0 || CDR(pcr) != NIL)) {
       ParserError("AnalyzeData", "too few initializers\n");
     }
 }

References CAR, CDR, constant_call_p, constant_int_p, copy_constant(), DATAVAL, dataval_constant, dataval_nboccurrences, DATAVAR, datavar_nbelements, datavar_variable, dynamic_area_p(), entity_blockdata_p(), entity_initial, entity_local_name(), entity_name, entity_scalar_p(), entity_storage, entity_undefined_p, free_value(), gen_length(), get_bool_property(), get_current_module_entity(), is_storage_ram, is_value_constant, make_ram(), make_storage(), make_value(), module_local_name(), NIL, ParserError(), pips_assert, pips_debug, pips_user_warning, ram_section, SaveEntity(), static_area_p(), StaticArea, storage_ram, storage_ram_p, storage_tag, storage_undefined_p, UNKNOWN_RAM_OFFSET, user_warning, value_undefined_p, value_unknown_p, and Warning.

Here is the call graph for this function:

◆ append_data_current_stmt_buffer_to_declarations()

void append_data_current_stmt_buffer_to_declarations ( void )

int[]

Definition at line 276 of file reader.c.

 {
     size_t i=0, j=0, column=6;
     char * tmp = (char*) malloc(lStmt+200), * ndecls, * odecls;
     code c = EntityCode(get_current_module_entity());
  
     for (; i<lStmt; i++, j++, column++) 
     {
       if (column==71) 
       {
         tmp[j++] = '\n';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         tmp[j++] = 'x';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         tmp[j++] = ' ';
         column = 10;
       }
       tmp[j] = (char) stmt_buffer[i]; /* int[] */
     }
     stmt_buffer[i]='\0';
     tmp[j] = '\0';
  
     odecls = code_decls_text(c);
     ndecls = strdup(concatenate(odecls, "! moved up...\n      DATA ", 
                                 tmp+4, 0));
     free(odecls);
     free(tmp);
     code_decls_text(c) = ndecls;
 }

References code_decls_text, concatenate(), EntityCode(), free(), get_current_module_entity(), lStmt, malloc(), stmt_buffer, and strdup().

Here is the call graph for this function:

◆ BeginingOfParsing()

void BeginingOfParsing ( void )

this function is called for each new file (FI: once?) FI: I do not understand how this works.

It has an effect only once during a pips process lifetime. The error handling routine resets CurrentPackage to NULL, as it is when the pips process is started.

Should I:

A modify the error handling routine to reset CurrentPackage to TOP_LEVEL_MODULE_NAME?

B reset CurrentPackage to TOP_LEVEL_MODULE_NAME each time the parser is entered?

I choose A.

the current package is initialized

Definition at line 208 of file parser.c.

 {
     static bool called = false;
  
     if (called)
         return;
  
     /* the current package is initialized */
     CurrentPackage = TOP_LEVEL_MODULE_NAME;
     called = true;
 }

References CurrentPackage, and TOP_LEVEL_MODULE_NAME.

Referenced by the_actual_parser().

Here is the caller graph for this function:

◆ BeginingOfProcedure()

void BeginingOfProcedure ( void )

this function is called each time a new procedure is encountered.

reset_current_module_entity();

Definition at line 301 of file procedure.c.

 {
     /* reset_current_module_entity(); */
     InitImplicit();
     called_modules = NIL;
 }

References called_modules, InitImplicit(), and NIL.

Here is the call graph for this function:

◆ CapitalizeStmt()

int CapitalizeStmt	(	char	s[],
		int	i
	)

la 1ere lettre n'est pas modifiee

Definition at line 1308 of file reader.c.

 {
     int l = i+strlen(s);
  
     if ((size_t) l <= lStmt) {
         /* la 1ere lettre n'est pas modifiee */
         i += 1;
         while (i < l) {
             stmt_buffer[i] = tolower(stmt_buffer[i]);
             i += 1;
         }
     }
     else {
         ParserError("CapitalizeStmt",
                     "[scanner] internal error in CapitalizeStmt\n");
     }
  
     return(i);
 }

References lStmt, ParserError(), and stmt_buffer.

Referenced by FindAssign(), FindAutre(), FindDo(), FindDoWhile(), FindIf(), FindIfArith(), FindImplicit(), and NeedKeyword().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ChainIntersection()

int ChainIntersection	(	cons *	opc1,
		cons *	opc2
	)

this function returns true if the there is a variable that occurs in both atom lists.

Parameters

opc1	pc1
opc2	pc2

Definition at line 302 of file equivalence.c.

 {
     cons *pc1, *pc2;
     
     for (pc1 = opc1; pc1 != NIL; pc1 = CDR(pc1))
             for (pc2 = opc2; pc2 != NIL; pc2 = CDR(pc2))
                     if (gen_eq((atom_equivar(ATOM(CAR(pc1)))),
                                (atom_equivar(ATOM(CAR(pc2))))))
                             return(true);
  
     return(false);
 }

References ATOM, atom_equivar, CAR, CDR, gen_eq(), and NIL.

Referenced by AddOrMergeChain().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ check_first_statement()

void check_first_statement ( void )

This function is called each time an executable statement is encountered but is effective the first time only.

It mainly copies the declaration text in the symbol table because it is impossible (very difficult) to reproduce it in a user-friendly manner.

The declaration text stops at the first executable statement or at the first FORMAT statement.

dynamic local buffer

we must read the input file from the begining and up to the line_b_I-1 th line, and the texte read must be stored in buffer

declaration_lines = line_b_I-1;

buffer[ibuffer++] = in_comment? c : toupper(c);

Constant strings must be taken care of

Standard version

For Cathare-2, get rid of 100 to 200 MB of declaration text:

strdup(buffer);

free(buffer), buffer=NULL;

kill the first statement's comment because it's already included in the declaration text

FI: I'd rather keep them together!

clean up the declarations

Common sizes are not yet known because ComputeAddresses() has not been called yet

update_common_sizes();

It might seem logical to perform these calls from EndOfProcedure() here. But at least ComputeAddresses() is useful for implictly declared variables. These calls are better located in EndOfProcedure().

Definition at line 2004 of file statement.c.

 {
     int line_start = true;
     int in_comment = false;
     int out_of_constant_string = true;
     int in_constant_string = false;
     int end_of_constant_string = false;
     char string_sep = '\000';
  
     if (! seen) 
     {
         FILE *fd;
         int cpt = 0, ibuffer = 0, c;
  
         /* dynamic local buffer
          */
         int buffer_size = 1000;
         char * buffer = (char*) malloc(buffer_size);
         pips_assert("malloc ok", buffer);
  
         seen = true;
         
         /* we must read the input file from the begining and up to the 
            line_b_I-1 th line, and the texte read must be stored in buffer */
  
         if(!format_seen) {
             /* declaration_lines = line_b_I-1; */
             debug(8, "check_first_statement", "line_b_C=%d, line_b_I=%d\n",
                   line_b_C, line_b_I);
             declaration_lines = (line_b_C!=UNDEF)?line_b_C-1:line_b_I-1;
         }
  
         fd = safe_fopen(CurrentFN, "r");
         while ((c = getc(fd)) != EOF) {
             if(line_start == true)
                 in_comment = strchr(START_COMMENT_LINE,c) != NULL;
             /* buffer[ibuffer++] = in_comment? c : toupper(c); */
             if(in_comment) {
               buffer[ibuffer++] =  c;
             }
             else {
               /* Constant strings must be taken care of */
               if(out_of_constant_string) {
                 if(c=='\'' || c == '"') {
                   string_sep = c;
                   out_of_constant_string = false;
                   in_constant_string = true;
                   buffer[ibuffer++] =  c;
                 } 
                 else {
                   buffer[ibuffer++] =  toupper(c);
                 }
               }
               else
                 if(in_constant_string) {
                   if(c==string_sep) {
                     in_constant_string = false;
                     end_of_constant_string = true;
                   }
                   buffer[ibuffer++] =  c;
                 }
                 else 
                   if(end_of_constant_string) {
                     if(c==string_sep) {
                       in_constant_string = true;
                       end_of_constant_string = false;
                       buffer[ibuffer++] =  c;
                     }
                     else {
                       out_of_constant_string = true;
                       end_of_constant_string = false;
                       buffer[ibuffer++] =  toupper(c);
                     }
                   }
             }
  
             if (ibuffer >= buffer_size-10)
             {
                 pips_assert("buffer initialized", buffer_size>0);
                 buffer_size*=2;
                 buffer = (char*) realloc(buffer, buffer_size);
                 pips_assert("realloc ok", buffer);
             }
  
             if (c == '\n') {
                 cpt++;
                 line_start = true;
                 in_comment = false;
             }
             else {
                 line_start = false;
             }
  
             if (cpt == declaration_lines)
                 break;
         }
         safe_fclose(fd, CurrentFN);
         buffer[ibuffer++] = '\0';
         /* Standard version */
         code_decls_text(EntityCode(get_current_module_entity())) = buffer;
         buffer = NULL;
         /* For Cathare-2, get rid of 100 to 200 MB of declaration text: */
         /*
            code_decls_text(EntityCode(get_current_module_entity())) = strdup("");
            free(buffer);
         */
         /* strdup(buffer); */
         /* free(buffer), buffer=NULL; */
  
         /* kill the first statement's comment because it's already
            included in the declaration text */
         /* FI: I'd rather keep them together! */
         /*
         PrevComm[0] = '\0';
         iPrevComm = 0;
         */
         /*
         Comm[0] = '\0';
         iComm = 0;
         */
  
         /* clean up the declarations */
         /* Common sizes are not yet known because ComputeAddresses() has not been called yet */
         /* update_common_sizes(); */
  
         /* It might seem logical to perform these calls from EndOfProcedure()
          * here. But at least ComputeAddresses() is useful for implictly 
          * declared variables. 
          * These calls are better located in EndOfProcedure().
          */
         /*
          * UpdateFunctionalType(FormalParameters);
          *
          * ComputeEquivalences();
          * ComputeAddresses();
          *
          * check_common_layouts(get_current_module_entity());
          *
          * SaveChains();
          */
     }
 }

References buffer, buffer_size, code_decls_text, cpt, CurrentFN, debug(), declaration_lines, EntityCode(), format_seen, get_current_module_entity(), line_b_C, line_b_I, malloc(), pips_assert, safe_fclose(), safe_fopen(), seen, START_COMMENT_LINE, and UNDEF.

Here is the call graph for this function:

◆ check_in_declarations()

void check_in_declarations ( void )

A FORMAT statement has been found in the middle of the declarations

Definition at line 1976 of file statement.c.

 {
     if(seen) {
         ParserError("Syntax", 
                     "Declaration appears after executable statement");
     }
     else if(format_seen && !seen) {
         /* A FORMAT statement has been found in the middle of the declarations */
         if(!get_bool_property("PRETTYPRINT_ALL_DECLARATIONS")) {
             pips_user_warning("FORMAT statement within declarations. In order to "
                               "analyze this code, "
                               "please set property PRETTYPRINT_ALL_DECLARATIONS "
                               "or move this FORMAT down in executable code.\n");
             ParserError("Syntax", "Source cannot be parsed with current properties");
         }
     }
 }

References format_seen, get_bool_property(), ParserError(), pips_user_warning, and seen.

Here is the call graph for this function:

◆ CheckAndInitializeStmt()

void CheckAndInitializeStmt ( void )

this function looks for undefined labels.

a label is undefined if a goto to that label has been encountered and if no statement with this label has been parsed.

Definition at line 113 of file statement.c.

 {
   int i;
   int MustStop = false;
  
   for (i = 0; i < CurrentStmt; i++) {
     statement s = StmtHeap_buffer[i].s;
     if (statement_instruction(s) == instruction_undefined) {
       MustStop = true;
       user_warning("CheckAndInitializeStmt", "Undefined label \"%s\"\n", 
                    label_local_name(statement_label(s)));
     }
   }
  
   if (MustStop) {
     ParserError("CheckAndInitializeStmt", "Undefined label(s)\n");
   }
   else {
     CurrentStmt = 0;
   }
 }

References CurrentStmt, instruction_undefined, label_local_name(), ParserError(), stmt::s, statement_instruction, statement_label, StmtHeap_buffer, and user_warning.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ CheckLeftHandSide()

syntax CheckLeftHandSide ( syntax s )

If a left hand side is a call, it should be a substring operator or a macro.

If it is a call to an intrinsic with no arguments, the intrinsic is in fact masqued by a local variable.

If s is not OK, it is freed and a new_s is allocated.

OK for substrings: They are processed later by MakeAssignInst()

Oupss... This must be a local variable

A call to an intrinsic cannot be a lhs: statement function? Let's hope it works...

Must be a macro...

Definition at line 542 of file expression.c.

 {
     syntax new_s = syntax_undefined;
  
     if(syntax_reference_p(s)) {
       entity v = reference_variable(syntax_reference(s));
       type vt = entity_type(v);
  
       if(type_variable_p(vt))
         new_s = s;
       else 
         pips_user_error("Illegal assignment to variable %s with type %s\n",
                         entity_local_name(v), type_to_string(vt));
     }
     else {
         call c = syntax_call(s);
         entity f = call_function(c);
  
         if(intrinsic_entity_p(f)) {
             if(strcmp(entity_local_name(f), SUBSTRING_FUNCTION_NAME)==0) {
                 /* OK for substrings: They are processed later by MakeAssignInst() */
                 pips_debug(7, "Substring assignment detected\n");
                 new_s = s;
             }
             else if(ENDP(call_arguments(c))) {
                 /* Oupss... This must be a local variable */
                 entity v = FindOrCreateEntity(get_current_module_name(), entity_local_name(f));
  
                 user_warning("CheckLeftHandSide",
                              "Name conflict between local variable %s and intrinsics %s\n",
                              entity_local_name(f), entity_name(f));
  
                 free_syntax(s);
                 reify_ghost_variable_entity(v);
                 new_s = make_syntax(is_syntax_reference, make_reference(v, NIL));
             }
             else {
                 /* A call to an intrinsic cannot be a lhs: statement function? 
                    Let's hope it works... */
                 user_warning("CheckLeftHandSide",
                              "Name conflict between statement function %s and intrinsics %s\n",
                              entity_local_name(f), entity_name(f));
                 new_s = s;
             }
         }
         else {
             /* Must be a macro... */
             pips_debug(2, "Statement function definition %s\n", entity_name(f));
             new_s = s;
         }
     }
  
     return new_s;
 }

References call_arguments, call_function, ENDP, entity_local_name(), entity_name, entity_type, f(), FindOrCreateEntity(), free_syntax(), get_current_module_name(), intrinsic_entity_p(), is_syntax_reference, make_reference(), make_syntax(), NIL, pips_debug, pips_user_error, reference_variable, reify_ghost_variable_entity(), SUBSTRING_FUNCTION_NAME, syntax_call, syntax_reference, syntax_reference_p, syntax_undefined, type_to_string(), type_variable_p, and user_warning.

Here is the call graph for this function:

◆ CheckParenthesis()

void CheckParenthesis ( void )

Warning("CheckParenthesis",

Definition at line 1032 of file reader.c.

 {
     register size_t i;
     int parenthese = 0;
  
     ProfZeroVirg = ProfZeroEgal = false;
  
     for (i = 0; i < lStmt; i++) {
         if (!IS_QUOTED(stmt_buffer[i])) {
             if (parenthese == 0) {
                 if (stmt_buffer[i] == ',')
                         ProfZeroVirg = true;
                 else if (stmt_buffer[i] == '=')
                         ProfZeroEgal = true;
             }
             if(stmt_buffer[i] == '(') parenthese ++;
             if(stmt_buffer[i] == ')') parenthese --;
         }
     }
     if(parenthese < 0) {
         for (i=0; i < lStmt; i++)
             (void) putc((char) stmt_buffer[i], stderr);
         /* Warning("CheckParenthesis", */
         ParserError("CheckParenthesis",
                     "unbalanced paranthesis (too many ')')\n"
                     "Due to line truncation at column 72?\n");
     }
     if(parenthese > 0) {
         for (i=0; i < lStmt; i++)
             (void) putc((char) stmt_buffer[i], stderr);
         ParserError("CheckParenthesis",
                     "unbalanced paranthesis (too many '(')\n"
                     "Due to line truncation at column 72?\n");
     }
 }

References IS_QUOTED, lStmt, ParserError(), ProfZeroEgal, ProfZeroVirg, and stmt_buffer.

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ common_to_defined_size_p()

bool common_to_defined_size_p ( entity a )

Definition at line 980 of file declaration.c.

 {
     bool defined = false;
  
     defined = ( (hash_get(common_size_map,(char *) a))
         != HASH_UNDEFINED_VALUE );
  
     return defined;
 }

References common_size_map, hash_get(), and HASH_UNDEFINED_VALUE.

Referenced by MakeCommon().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ common_to_size()

size_t common_to_size ( entity a )

Definition at line 990 of file declaration.c.

 {
     size_t size;
  
     if((size = (size_t) hash_get(common_size_map,(char *) a))
        == (size_t) HASH_UNDEFINED_VALUE) {
             pips_internal_error("common_size_map uninitialized for common %s",
                        entity_name(a));
     }
  
     return size;
 }

References common_size_map, entity_name, hash_get(), HASH_UNDEFINED_VALUE, and pips_internal_error.

Referenced by ComputeAddresses(), CurrentOffsetOfArea(), fortran_relevant_area_entity_p(), update_common_layout(), and update_common_sizes().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ComputeAddresses()

void ComputeAddresses ( void )

This function computes an address for every variable.

Three different cases are adressed: variables in user-declared commons, static variables and dynamic variables.

Variables may have:

an undefined storage because they have the default dynamic storage or because they should inherit their storage from an equivalence chain. The inherited storage can be "user-declared common", "static" or even "dynamic".
a user-declared common storage. The offsets of these variables can be computed from the common partial layout. Offsets for variables equivalenced to one of them are derived and the layouts are updated.
a static storage: the offset must be unknown on entrance in this function.
a dynamic storage: this is forbidden because there is no DYNAMIC declaration. The Fortran programmer does not have a way to enforce explictly a dynamic storage. All dynamic variables have an undefined storage upon entrance.
a non-ram storage: this obviously is forbidden.

All variables explictly declared in a common have a storage fully defined within this common (see update_common_layout() which must have been called before entering ComputeAddresses()). If such a variable occurs in an equivalence chain, all other variables of this chain will have an address in this common. The exact address depends on the offset stored in the atom.

The variables allocated in the static and dynamic areas are handled differently from variables explicitly declared in a common because the programmer does not have a direct control over the offset as within a common declaration. An arbitrary allocation is performed. The same kind of processing is done for chains containing a static variable or only dynamic variables (i.e. each variable in the chain has an undefined storage).

Static variables obviously have a partially defined storage since they are recognized as static.

Each equivalence chain should be either attached to a user-declared common or to the static area or to the dynamic area of the current module.

Static and dynamic chains are processed in a similar way. The size of each chain is computed and the space for the chain is allocated in the corresponding area. As for user-declared commons (but with no good reason?) only one representant of each chain is added to the layouts of the area.

When the processing of equivalenced variables is completed, non-equivalenced static or dynamic (i.e. variables with undefined storage) variables are allocated.

Finally equivalenced variables are appended to the layouts of the static and dynamic areas. This makes update_common_layout() unapplicable.

As a result, variables declared in the static and dynamic area are not ordered by increasing offsets.

the default section for variables with no address is the dynamic area.

Try to locate the area for the current equivalence chain. Only one variable should have a well-defined storage. Or no variables have one because the equivalence chain is located in the dynamic area.

Compute the total size of the chain. This only should be used for the static and dynamic areas

FI: I do not understand why this assignment is not better guarded. Maybe, because lc's later use is guarded.

A variable may be located in a static area because of a SAVE (?) or a DATA statement and be equivalenced with a variable in a common.

Same as above but in a different order

Let's hope this is due to a DATA and not to a SAVE

Compute the offset and set the storage information for each variable in the equivalence chain that has no storage yet.

check that the offset is positive

Static aliases cannot be added right away because implicitly declared static variables still have to be added whereas aliased variables are assumed to be put behind in the layout list. Except the first one.

Well, I'm not so sure!

Add e in sc'layout and check that sc's size does not have to be increased as for: COMMON /FOO/X REAL Y(100) EQUIVALENCE (X,Y)

Dynamic aliases cannot be added right away because implicitly declared dynamic variables still have to be added whereas aliased variables are assumed to be put behind in the layout list. Except the first one.

If sc really is a common, i.e. neither the dynamic nor the static area, check its size

Varying size arrays must be stack allocated. This is an implicit extension that is not compatible with EQUIVALENCE

This test will fail for stack allocatable varying length character strings because of function SizeOfElements() which cannot indicate failure. Let's wait for the problem...

Try to reallocate in stack area

Formal parameters can have varying sizes

Allocatable arrays can have varying sizes

Could be declared explicitly or implicitly STATIC or be EQUIVALENCEd with such a variable. It could be declared in a COMMON.

The array size is known at compile time. Allocate in synamic area.

All declared variables are scanned and stored in the dynamic area if their storage is still undefined or in the static area if their offsets are still unkown.

This should be the case for all non-aliased static variables and most dynamic variables.

area da = type_area(entity_type(DynamicArea));

area_layout(da) = gen_nconc(area_layout(da), CONS(ENTITY, e, NIL));

area sa = type_area(entity_type(StaticArea));

area_layout(sa) = gen_nconc(area_layout(sa), CONS(ENTITY, e, NIL));

Must be stack area

Add aliased dynamic variables

neither gen_concatenate() nor gen_append() are OK

side effect on area_layout

Add aliased static variables

neither gen_concatenate() nor gen_append() are OK

side effect on area_layout

The sizes of the static and dynamic areas are now known

Definition at line 503 of file equivalence.c.

 {
     cons *pcc, *pca, *pcv;
     entity sc;
     int lc, l, ac;
     list dynamic_aliases = NIL;
     list static_aliases = NIL;
  
     pips_debug(1, "Begin\n");
  
     if (FinalEquivSet != equivalences_undefined) {
         for (pcc = equivalences_chains(FinalEquivSet); pcc != NIL; 
              pcc = CDR(pcc)) {
             chain c = CHAIN(CAR(pcc));
  
             /* the default section for variables with no address is the dynamic
              * area.  */
             sc = DynamicArea;
             lc = 0;
             ac = 0;
  
             /* Try to locate the area for the current equivalence chain.
              * Only one variable should have a well-defined storage.
              * Or no variables have one because the equivalence chain 
              * is located in the dynamic area.
              */
             for (pca = chain_atoms(c); pca != NIL; pca = CDR(pca)) {
                 entity e;
                 int o;
  
                 e = atom_equivar(ATOM(CAR(pca)));
                 o = atom_equioff(ATOM(CAR(pca)));
  
                 /* Compute the total size of the chain. This only should
                    be used for the static and dynamic areas */
                 /* FI: I do not understand why this assignment is not better guarded.
                  * Maybe, because lc's later use *is* guarded.
                  */
                 if ((l = SafeSizeOfArray(e)) > lc-o)
                     lc = l+o;
  
                 if (entity_storage(e) != storage_undefined) {
                     if (storage_ram_p(entity_storage(e))) {
                         ram r = storage_ram(entity_storage(e));
  
                         if (sc != ram_section(r)) {
                             if (sc == DynamicArea) {
                                 sc = ram_section(r);
                                 ac = ram_offset(r)-o;
                             } 
                             else if (sc == StaticArea) {
                                 /* A variable may be located in a static area because
                                  * of a SAVE (?) or a DATA statement and be equivalenced
                                  * with a variable in a common.
                                  */
                                 pips_assert("ComputeAddresses", ram_section(r) != DynamicArea);
                                 sc = ram_section(r);
                                 ac = ram_offset(r)-o;
                             }
                             else if(ram_section(r) == StaticArea) {
                               /* Same as above but in a different order */
                               /* Let's hope this is due to a DATA and not to a SAVE */
                               ram_section(r) = sc;
                             }
                             else {
                                 user_warning("ComputeAddresses",
                                              "Incompatible default area %s and "
                                              "area %s requested by equivalence for %s\n",
                                              entity_name(sc), entity_name(ram_section(r)),
                                              entity_local_name(e));
                                 ParserError("ComputeAddresses",
                                             "incompatible areas\n");
                             }
                         }
                     }
                     else
                         FatalError("ComputeAddresses", "non ram storage\n");
                 }
             }
  
             /* Compute the offset and set the storage information for each
              * variable in the equivalence chain that has no storage yet.
              */
             for (pca = chain_atoms(c); pca != NIL; pca = CDR(pca)) {
                 entity e;
                 int o, adr;
  
                 e = atom_equivar(ATOM(CAR(pca)));
                 o = atom_equioff(ATOM(CAR(pca)));
  
                 if (sc == DynamicArea || sc == StaticArea) {
                     ac = area_size(type_area(entity_type(sc)));
                 }
  
                 /* check that the offset is positive */
                 if ((adr = ac+o) < 0) {
                     user_warning("ComputeAddresses", "Offset %d for %s in common /%s/.\n",
                                  ac+o, entity_local_name(e), entity_local_name(sc));
                     ParserError("ComputeAddresses", 
                                 "Attempt to extend common backwards. "
                                 "Have you checked the code with a Fortran compiler?\n");
                 }
  
                 if ((entity_storage(e)) != storage_undefined) {
                     ram r;
                     r = storage_ram(entity_storage(e));
  
                     if (adr != ram_offset(r)) {
                         if(ram_offset(r)==UNKNOWN_RAM_OFFSET && ram_section(r)==StaticArea) {
                             ram_offset(r) = adr;
                             if(sc == StaticArea && pca != chain_atoms(c)) {
                                 /* Static aliases cannot be added right away because
                                  * implicitly declared static variables still have to
                                  * be added whereas aliased variables are assumed to be
                                  * put behind in the layout list. Except the first one.
                                  *
                                  * Well, I'm not so sure!
                                  */
                                 static_aliases = arguments_add_entity(static_aliases, e);
                             }
                             else {
                                 area a = type_area(entity_type(sc));
  
                                 area_layout(a) = gen_nconc(area_layout(a),
                                                            CONS(ENTITY, e, NIL));
                             }
                         }
                         else if(ram_offset(r)==UNKNOWN_RAM_OFFSET) {
                           ram_offset(r) = adr;
                         }
                         else {
                             user_warning("ComputeAddresses",
                                          "Two conflicting offsets for %s: %d and %d\n",
                                          entity_local_name(e), adr, ram_offset(r));
                             ParserError("ComputeAddresses", "incompatible addresses\n");
                         }
                     }
                 }
                 else {
                     area a = type_area(entity_type(sc));
  
                     entity_storage(e) = 
                         make_storage(is_storage_ram,
                                      (make_ram(get_current_module_entity(), 
                                                sc, adr, NIL)));
                     /* Add e in sc'layout and check that sc's size
                      * does not have to be increased as for:
                      * COMMON /FOO/X
                      * REAL Y(100)
                      * EQUIVALENCE (X,Y)
                      */
                     pips_assert("Entity e is not yet in sc's layout", 
                                 !entity_is_argument_p(e,area_layout(a)));
                     if(sc == DynamicArea && pca != chain_atoms(c)) {
                         /* Dynamic aliases cannot be added right away because
                          * implicitly declared dynamic variables still have to
                          * be added whereas aliased variables are assumed to be
                          * put behind in the layout list. Except the first one.
                          */
                         dynamic_aliases = arguments_add_entity(dynamic_aliases, e);
                     }
                     else {
                         area_layout(a) = gen_nconc(area_layout(a),
                                                    CONS(ENTITY, e, NIL));
                     }
  
                     /* If sc really is a common, i.e. neither the *dynamic*
                      * nor the *static* area, check its size
                      */
                     if(top_level_entity_p(sc)) {
                         int s = common_to_size(sc);
                         int new_s = adr + SafeSizeOfArray(e);
                         if(s < new_s) {
                             (void) update_common_to_size(sc, new_s);
                         }
                     }
                 }
             }
  
             if (sc == DynamicArea || sc == StaticArea)
                 area_size(type_area(entity_type(sc))) += lc;
  
         }
     }
  
     /* Varying size arrays must be stack allocated. This is an implicit
        extension that is not compatible with EQUIVALENCE */
  
     if(get_bool_property("PARSER_ACCEPT_ANSI_EXTENSIONS")) {
       pips_debug(2, "Process stack variables\n");
  
       for (pcv = code_declarations(EntityCode(get_current_module_entity())); pcv != NIL;
            pcv = CDR(pcv)) {
         entity a = ENTITY(CAR(pcv));
         int s;
  
         /* This test will fail for stack allocatable varying length
            character strings because of function SizeOfElements() which
            cannot indicate failure. Let's wait for the problem... */
         if(type_variable_p(entity_type(a))
            && !(!storage_undefined_p(entity_storage(a)) && storage_formal_p(entity_storage(a)))
            && !SizeOfArray(a, &s)) {
           /* Try to reallocate in stack area */
           s = 0;
           if(storage_undefined_p(entity_storage(a))) {
             entity_storage(a) = make_storage(is_storage_ram,
                                              make_ram(get_current_module_entity(),
                                                       StackArea,
                                                       UNKNOWN_RAM_OFFSET,
                                                       NIL));
  
             pips_debug(8, "Variable %s allocated in stack\n", entity_local_name(a));
           }
           else if(storage_formal_p(entity_storage(a))) {
             /* Formal parameters can have varying sizes */
             ;
           }
           else if(storage_ram_p(entity_storage(a))) {
             entity sec = ram_section(storage_ram(entity_storage(a)));
  
             if(sec==DynamicArea) {
               ram_section(storage_ram(entity_storage(a)))=StackArea;
               pips_debug(8, "Variable %s reallocated in stack\n", entity_local_name(a));
             }
             else if(sec==HeapArea) {
               /* Allocatable arrays can have varying sizes */
               ;
             }
             else {
               /* Could be declared explicitly or implicitly STATIC or be
                  EQUIVALENCEd with such a variable. It could be declared
                  in a COMMON. */
               pips_user_warning("Variable %s with varying dimension cannot be reallocated"
                                 " in stack because it has already been allocated in %s\n",
                                 entity_local_name(a), entity_local_name(sec));
               ParserError(__FUNCTION__, "Storage cannot be redefined to stack");
             }
           }
           else {
             pips_internal_error("Unexpected storage for entity %s",
                                 entity_local_name(a));
           }
         }
         else {
           /* The array size is known at compile time. Allocate in synamic
              area. */
           ;
         }
       }
     }
  
     /* All declared variables are scanned and stored in the dynamic area if their
      * storage is still undefined or in the static area if their offsets are still
      * unkown.
      *
      * This should be the case for all non-aliased static variables and most dynamic
      * variables.
      *
      */
  
     pips_debug(2, "Process left-over dynamic variables\n");
  
     for (pcv = code_declarations(EntityCode(get_current_module_entity())); pcv != NIL;
          pcv = CDR(pcv)) {
         entity e = ENTITY(CAR(pcv));
  
         if (entity_storage(e) == storage_undefined) {
             /* area da = type_area(entity_type(DynamicArea)); */
  
             pips_debug(2, "Add dynamic non-aliased variable %s\n",
                   entity_local_name(e));
  
             entity_storage(e) = 
                 make_storage(is_storage_ram,
                              (make_ram(get_current_module_entity(), 
                                        DynamicArea, 
                                        current_offset_of_area(DynamicArea,
                                                               e), NIL)));
             /* area_layout(da) = gen_nconc(area_layout(da), CONS(ENTITY, e, NIL)); */
         }
         else if(storage_ram_p(entity_storage(e))) {
             ram r = storage_ram(entity_storage(e));
             if(ram_offset(r)==UNKNOWN_RAM_OFFSET) {
                 if(ram_section(r)==StaticArea) {
                     /* area sa = type_area(entity_type(StaticArea)); */
  
                     pips_debug(2, "Add static non-aliased variable %s\n",
                           entity_local_name(e));
  
                     ram_offset(r) = current_offset_of_area(StaticArea, e);
                     /* area_layout(sa) = gen_nconc(area_layout(sa), CONS(ENTITY, e, NIL)); */
                 }
                 else if(ram_section(r)==HeapArea) {
                     area ha = type_area(entity_type(HeapArea));
  
                     pips_debug(2,
                           "Ignore heap variable %s because its address cannot be computed\n",
                           entity_local_name(e));
                     area_layout(ha) = gen_nconc(area_layout(ha), CONS(ENTITY, e, NIL));
                 }
                 else {
                   /* Must be stack area */
                     area sa = type_area(entity_type(StackArea));
  
                     pips_debug(2,
                           "Ignore stack variable %s because its address cannot be computed\n",
                           entity_local_name(e));
                     area_layout(sa) = gen_nconc(area_layout(sa), CONS(ENTITY, e, NIL));
                 }
             }
         }
      }
  
     /* Add aliased dynamic variables */
     if(!ENDP(dynamic_aliases)) {
         /* neither gen_concatenate() nor gen_append() are OK */
         list dynamics = area_layout(type_area(entity_type(DynamicArea)));
  
         ifdebug(2) {
             pips_debug(2, "There are dynamic aliased variables:");
             print_arguments(dynamic_aliases);
         }
  
         pips_assert("aliased dynamic variables imply standard dynamic variables",
                     !ENDP(dynamics));
         /* side effect on area_layout */
         (void) gen_nconc(dynamics, dynamic_aliases);
     }
  
     /* Add aliased static variables */
     if(!ENDP(static_aliases)) {
         /* neither gen_concatenate() nor gen_append() are OK */
         list statics = area_layout(type_area(entity_type(StaticArea)));
  
         ifdebug(2) {
             pips_debug(2, "There are static aliased variables:");
             print_arguments(static_aliases);
         }
  
         pips_assert("aliased static variables imply standard static variables",
                     !ENDP(statics));
         /* side effect on area_layout */
         (void) gen_nconc(statics, static_aliases);
     }
  
     /* The sizes of the static and dynamic areas are now known */
     update_common_to_size(StaticArea,
                           area_size(type_area(entity_type(StaticArea))));
     update_common_to_size(DynamicArea,
                           area_size(type_area(entity_type(DynamicArea))));
  
     pips_debug(1, "End\n");
 }

References area_layout, area_size, arguments_add_entity(), ATOM, atom_equioff, atom_equivar, CAR, CDR, CHAIN, chain_atoms, code_declarations, common_to_size(), CONS, current_offset_of_area(), DynamicArea, ENDP, ENTITY, entity_is_argument_p(), entity_local_name(), entity_name, entity_storage, entity_type, EntityCode(), equivalences_chains, equivalences_undefined, FatalError, FinalEquivSet, gen_nconc(), get_bool_property(), get_current_module_entity(), HeapArea, ifdebug, is_storage_ram, make_ram(), make_storage(), NIL, ParserError(), pips_assert, pips_debug, pips_internal_error, pips_user_warning, print_arguments(), ram_offset, ram_section, SafeSizeOfArray(), SizeOfArray(), StackArea, StaticArea, storage_formal_p, storage_ram, storage_ram_p, storage_undefined, storage_undefined_p, top_level_entity_p(), type_area, type_variable_p, UNKNOWN_RAM_OFFSET, update_common_to_size(), and user_warning.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ComputeEquivalences()

void ComputeEquivalences ( void )

This function merges all the equivalence chains to take into account equivalences due to transitivity.

It is called at the end of the parsing.

They should be properly initialized by SetChains if (FinalEquivSet == equivalences_undefined) { FinalEquivSet = make_equivalences(NIL); }

Definition at line 215 of file equivalence.c.

 {
     cons *pc;
     int again = true;
  
     pips_debug(8, "Begin\n");
  
     /*
     if (TempoEquivSet == equivalences_undefined) {
         pips_debug(8, "Useless call, end\n");
             return;
     }
     */
  
     if (ENDP(equivalences_chains(TempoEquivSet))) {
         pips_debug(8, "No equivalences to process, end\n");
             return;
     }
  
     /* They should be properly initialized by SetChains
     if (FinalEquivSet == equivalences_undefined) {
         FinalEquivSet = make_equivalences(NIL);
     }
     */
  
     pips_debug(8, "Initial equivalence chains\n");
     PrintChains(TempoEquivSet);
  
     while (again) {
         for (pc = equivalences_chains(TempoEquivSet); pc != NIL; pc = CDR(pc))
             again = (AddOrMergeChain(CHAIN(CAR(pc))) == EQUIMERGE);
  
         if (again) {
             free_equivalences(TempoEquivSet);
             TempoEquivSet = FinalEquivSet;
             FinalEquivSet = make_equivalences(NIL);
  
             pips_debug(8, "Intermediate equivalence chains\n");
             PrintChains(TempoEquivSet);
         }
     }
  
     pips_debug(8, "Resulting equivalence chains\n");
  
     PrintChains(FinalEquivSet);
  
     pips_debug(8, "End\n");
 }

References AddOrMergeChain(), CAR, CDR, CHAIN, ENDP, EQUIMERGE, equivalences_chains, FinalEquivSet, free_equivalences(), make_equivalences(), NIL, pips_debug, PrintChains(), and TempoEquivSet.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ cr_implicit()

void cr_implicit	(	tag	t,
		int	l,
		int	lettre_d,
		int	lettre_f
	)

this function updates the data structure used to compute implicit types.

the implicit type for the range of letters defined by lettre_d and lettre_f has tag t and length l. tag is_basic_string is temporarely forbidden.

Parameters

lettre_d	ettre_d
lettre_f	ettre_f

Definition at line 1284 of file declaration.c.

 {
     int i;
  
     /*
     if (t == is_basic_string)
             ParserError("cr_implicit",
                         "Unsupported implicit character declaration\n");
                         */
  
     if ((! IS_UPPER(lettre_d)) || (! IS_UPPER(lettre_f)))
             FatalError("cr_implicit", "bad char\n");    
  
     for (i = lettre_d-'A'; i <= lettre_f-'A'; i += 1) {
         tag_implicit[i] = t;
         int_implicit[i] = l;
     }
 }

References FatalError, int_implicit, IS_UPPER, and tag_implicit.

Referenced by InitImplicit().

Here is the caller graph for this function:

◆ CurrentOffsetOfArea()

int CurrentOffsetOfArea	(	entity	a,
		entity	v
	)

the local areas are StaticArea, DynamicArea, HeapArea, StackArea

Definition at line 1195 of file declaration.c.

 {
   int OldOffset;
   type ta = entity_type(a);
   area aa = type_area(ta);
  
   if(top_level_entity_p(a)) {
     OldOffset = common_to_size(a);
     (void) update_common_to_size(a, OldOffset+SafeSizeOfArray(v));
   }
   else {
     /* the local areas are StaticArea, DynamicArea, HeapArea, StackArea */
     OldOffset = area_size(aa);
     area_size(aa) = OldOffset+SafeSizeOfArray(v);
   }
  
   area_layout(aa) = gen_nconc(area_layout(aa), CONS(ENTITY, v, NIL));
   return OldOffset;
 }

References area_layout, area_size, common_to_size(), CONS, ENTITY, entity_type, gen_nconc(), NIL, SafeSizeOfArray(), top_level_entity_p(), type_area, and update_common_to_size().

Referenced by add_entity_to_declarations(), and gfc2pips_code2instruction__TOP().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ DeclareExternalFunction()

entity DeclareExternalFunction ( entity e )

It might be better to declare an unknown type as result type but I decided to fix the problem later. When a call is later encountered, the result type is set to void.

Parameters

e	entity to be turned into external function or subroutine, except if it is a formal functional parameter.

Definition at line 2426 of file procedure.c.

 {
   entity fe = entity_undefined;
  
   if(!type_undefined_p(entity_type(e))
      && storage_defined_p(entity_storage(e))
      && type_functional_p(entity_type(e))
      && storage_formal_p(entity_storage(e))) {
     fe = e;
   }
   else {
     /* It might be better to declare an unknown type as result type but I
        decided to fix the problem later. When a call is later encountered,
        the result type is set to void. */
     fe = MakeExternalFunction(e, type_undefined);
  
     if(value_intrinsic_p(entity_initial(fe))) {
       pips_user_warning(
                         "Name conflict between user declared module %s and intrinsic %s\n",
                         module_local_name(fe), module_local_name(fe));
       ParserError("DeclareExternalFunction",
                   "Name conflict with intrinsic because PIPS does not support"
                   " a specific name space for intrinsics. "
                   "Please change your function or subroutine name.");
     }
   }
  
   return fe;
 }

References entity_initial, entity_storage, entity_type, entity_undefined, MakeExternalFunction(), module_local_name(), ParserError(), pips_user_warning, storage_defined_p(), storage_formal_p, type_functional_p, type_undefined, type_undefined_p, and value_intrinsic_p.

Here is the call graph for this function:

◆ DeclareIntrinsic()

void DeclareIntrinsic ( entity e )

Intrinsic e is used in the current module.

Definition at line 918 of file declaration.c.

 {
     pips_assert("entity is defined", e!=entity_undefined && intrinsic_entity_p(e));
  
     AddEntityToDeclarations(e, get_current_module_entity());
 }

References AddEntityToDeclarations(), entity_undefined, get_current_module_entity(), intrinsic_entity_p(), and pips_assert.

Here is the call graph for this function:

◆ DeclarePointer()

void DeclarePointer	(	entity	ptr,
		entity	pointed_array,
		list	decl_dims
	)

It is assumed that decl_tableau can be ignored for EDF examples

A varying dimension is impossible in the dynamic area for address computation. A heap area must be added.

dims = decl_dims;

No specific type for SUN pointers

EDF code contains several declaration for a unique pointer

Parameters

ptr	tr
pointed_array	ointed_array
decl_dims	ecl_dims

Definition at line 546 of file declaration.c.

 {
   /* It is assumed that decl_tableau can be ignored for EDF examples */
   list dims = list_undefined;
  
   if(!get_bool_property("PARSER_ACCEPT_ANSI_EXTENSIONS")) {
     pips_user_warning("Non-standard pointer declaration. "
                       "Set property PARSER_ACCEPT_ANSI_EXTENSIONS to true.\n");
   }
  
   if(!ENDP(decl_dims)) {
     /* A varying dimension is impossible in the dynamic area for address
      * computation. A heap area must be added.
      */
  
     dims =
       CONS(DIMENSION,
            make_dimension(int_to_expression(1),
                           MakeNullaryCall(CreateIntrinsic(UNBOUNDED_DIMENSION_NAME)),
                           NIL),
            NIL);
  
     /* dims = decl_dims; */
   }
   else {
     dims = decl_dims;
   }
  
   pips_user_warning("SUN pointer declaration detected. Integer type used.\n");
   /* No specific type for SUN pointers */
   if(type_undefined_p(entity_type(ptr))) {
     DeclareVariable(ptr, MakeTypeVariable(MakeBasic(is_basic_int), NIL),
                     NIL, storage_undefined, value_undefined);
   }
   else if(implicit_type_p(ptr)) {
     DeclareVariable(ptr, MakeTypeVariable(MakeBasic(is_basic_int), NIL),
                     NIL, storage_undefined, value_undefined);
   }
   else {
     type tp = entity_type(ptr);
  
     if(type_variable_p(tp)
        && basic_int_p(variable_basic(type_variable(tp)))) {
       /* EDF code contains several declaration for a unique pointer */
       pips_user_warning("%s %s between lines %d and % d\n",
                         "Redefinition of pointer",
                         entity_local_name(ptr), line_b_I, line_e_I);
  
     }
     else {
       pips_user_warning("DeclarePointer",
                         "%s %s between lines %d and % d\n",
                         "Redefinition of type for entity",
                         entity_local_name(ptr), line_b_I, line_e_I);
       ParserError("Syntax", "Conflicting type declarations\n");
     }
   }
   DeclareVariable(pointed_array, type_undefined, dims, 
                   make_storage(is_storage_ram,
                                make_ram(get_current_module_entity(),
                                         HeapArea,
                                         UNKNOWN_RAM_OFFSET,
                                         NIL)),
                   value_undefined);
 }

References basic_int_p, CONS, CreateIntrinsic(), DeclareVariable(), DIMENSION, ENDP, entity_local_name(), entity_type, get_bool_property(), get_current_module_entity(), HeapArea, implicit_type_p(), int_to_expression(), is_basic_int, is_storage_ram, line_b_I, line_e_I, list_undefined, make_dimension(), make_ram(), make_storage(), MakeBasic(), MakeNullaryCall(), MakeTypeVariable(), NIL, ParserError(), pips_user_warning, storage_undefined, type_undefined, type_undefined_p, type_variable, type_variable_p, UNBOUNDED_DIMENSION_NAME, UNKNOWN_RAM_OFFSET, value_undefined, and variable_basic.

Here is the call graph for this function:

◆ DeclareVariable()

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 encountered.

Examples of sequences:

INTEGER*4 T DIMENSION T(10) SAVE T

or COMMON /TOTO/X,Y CHARACTER*30 X DIMENSION X(10)

or EXTERNAL F INTEGER F

The input code is assumed correct. As the standard states, IMPLICIT statements must occur before any declaration.

Parameters: e is an entity which should be either a variable or a funtion; it may already have a type et, of kind variable or functional; the type variable may have a dimension; variable or functional implicit types, as well as undefined type, can be superseded by the new type t; a NIL type dimension can be superseded by d; how should area entities be handled ??? t is a type of kind "variable" (functional types are not accepted; functional declaration are handled by ??? ) or undefined; it should have no dimensions; d is a (possibly) empty list of dimensions; the empty list is handled as the undefined list; each dimension is an expression s is the storage, possibly undefined; v is the initial value, possibly undefined

Most problems occur because of the great number of combinations between the entity type et (undefined, variable, functional) and the entity type dimension etd (NIL ot not) giving 7 cases on one hand, the type t and the dimensions d giving 4 cases on the other hand. That is 28 different behaviors.

No sharing is introduced between t and et. However d and s are directly used in e fields.

no new information: do nothing

update functional type

the old type should be gen_freed...

set dimension etd if NIL

update type

I: to check update_common_layout

FI: it should be redefined and the offset be updated, maybe in check_common_area(); 1 Feb. 1994

Exception: since it is a synthetic variable, it is unlikely to be typed explicitly. But it can appear in later PIPS regenerated declarations. Unless there is a clash with a user variable.

No problem, but do not free t because this is performed in gram.y

free_type(t);

If the return variable is retyped, the function must be retyped

the pointed area has just been freed!

Meaningless warning when the result variable is declared the first time with the function itself user_warning("DeclareVariable", "Attempt to retype function %s with result of type " "%s with very same type %s\n", module_local_name(f), basic_to_string(old), basic_to_string(new));

Definition at line 670 of file declaration.c.

 {
   type et = entity_type(e);
   list etd = list_undefined;
   bool variable_had_implicit_type_p = false;
  
   debug(8, "DeclareVariable", "%s\n", entity_name(e));
   pips_assert("DeclareVariable", t == type_undefined || type_variable_p(t));
  
   if(et == type_undefined) {
     if(t == type_undefined) {
       entity_type(e) = ImplicitType(e);
       variable_dimensions(type_variable(entity_type(e))) = d;
     }
     else {
       type nt;
       nt = MakeTypeVariable
         (copy_basic(variable_basic(type_variable(t))),
          d);
       entity_type(e) = nt;
     }
   }
   else
     switch(type_tag(et)) {
     case is_type_functional:
       if(d!=NIL) {
         user_warning("DeclareVariable",
                      "%s %s between lines %d and % d\n",
                      "Attempt to dimension functional entity",
                      entity_local_name(e), line_b_I, line_e_I);
         ParserError("DeclareVariable", "Likely name conflict\n");
       }
       if(t == type_undefined)
         /* no new information: do nothing */
         ;
       else 
         if (implicit_type_p(e)) {
           /* update functional type */
           type nt = MakeTypeVariable
             (copy_basic(variable_basic(type_variable(t))),
              NIL);
           functional_result(type_functional(et)) = nt;
           /* the old type should be gen_freed... */
         }
         else if(type_equal_p(t, functional_result(type_functional(et)))) {
           user_warning("DeclareVariable",
                        "%s %s between lines %d and % d\n",
                        "Redefinition of functional type for entity",
                        entity_local_name(e), line_b_I, line_e_I);
         }
         else {
           user_warning("DeclareVariable",
                        "%s %s between lines %d and % d\n",
                        "Modification of functional result type for entity",
                        entity_local_name(e), line_b_I, line_e_I);
           ParserError("DeclareVariable",
                       "Possible name conflict?\n");
         }
       break;
     case is_type_variable:
       etd = variable_dimensions(type_variable(et));
       if(t == type_undefined) {
         /* set dimension etd if NIL */
         if(etd==NIL)
           variable_dimensions(type_variable(et)) = d;
         else if (d==NIL)
           ;
         else {
           user_warning("DeclareVariable",
                        "%s %s between lines %d and % d\n",
                        "Redefinition of dimension for entity",
                        entity_name(e), line_b_I, line_e_I);
           ParserError("DeclareVariable", "Name conflict?\n");
         }
       }
       else {
         pips_assert("DeclareVariable",
                     variable_dimensions(type_variable(t))==NIL);
         if(implicit_type_p(e)){
           type nt;
  
           variable_had_implicit_type_p = true;
  
           /* set dimension etd if NIL */
           if(etd==NIL)
             variable_dimensions(type_variable(et)) = d;
           else if (d==NIL)
             ;
           else {
             user_warning("DeclareVariable",
                          "%s %s between lines %d and % d\n",
                          "Redefinition of dimension for entity",
                          entity_local_name(e), line_b_I, line_e_I);
             ParserError("DeclareVariable", "Name conflict?\n");
           }
           /* update type */
           nt = MakeTypeVariable
             (copy_basic(variable_basic(type_variable(t))),
              variable_dimensions(type_variable(et)));
                     
           if(!same_basic_and_scalar_p(entity_type(e), nt))
             {
                         
               if(/*FI: to check update_common_layout*/ false && 
                  entity_storage(e)!=storage_undefined &&
                  storage_ram_p(entity_storage(e)) &&
                  basic_type_size(variable_basic(type_variable(t)))
                  > basic_type_size(variable_basic(type_variable(entity_type(e))))) 
                 {
                   user_warning("DeclareVariable",
                                "Storage information for %s is likely to be wrong because its type is "
                                "redefined as a larger type\nType is *not* redefined internally to avoid "
                                "aliasing\n", entity_local_name(e));
                   /* FI: it should be redefined and the offset be updated,
                    * maybe in check_common_area(); 1 Feb. 1994
                    */
                 }
               else {
                 entity_type(e) = nt;
               }
             }
           else {
             free_type(nt);
           }
         }
         else {
           if(formal_label_replacement_p(e)) {
             /* Exception: since it is a synthetic variable, it is
                unlikely to be typed explicitly. But it can appear
                in later PIPS regenerated declarations. Unless
                there is a clash with a user variable. */
             if(type_equal_p(entity_type(e), t)) {
               /* No problem, but do not free t because this is performed in gram.y */
               /* free_type(t); */
             }
             else {
               pips_user_warning(
                                 "%s %s between lines %d and % d\n",
                                 "Redefinition of type for formal label substitution entity",
                                 entity_name(e), line_b_I, line_e_I);
               ParserError("DeclareVariable",
                           "Name conflict for formal label substitution variable? "
                           "Use property PARSER_FORMAL_LABEL_SUBSTITUTE_PREFIX?\n");
             }
           }
           else {
             pips_user_warning(
                               "%s %s between lines %d and % d\n",
                               "Redefinition of type for entity",
                               entity_name(e), line_b_I, line_e_I);
             ParserError("DeclareVariable",
                         "Name conflict or declaration ordering "
                         "not supported by PIPS\n"
                         "Late typing of formal parameter and/or "
                         "interference with IMPLICIT\n");
           }
         }
       }
       break;
     case is_type_area:
       user_warning("DeclareVariable",
                    "%s %s between lines %d and % d\n%s\n",
                    "COMMON/VARIABLE homonymy for entity name",
                    entity_local_name(e), line_b_I, line_e_I,
                    "Rename your common.");
       ParserError("DeclareVariable", "Name conflict\n");
       break;
     default:
       pips_internal_error("unexpected entity type tag: %d",
                  type_tag(et));
     }
  
   if (s != storage_undefined) {
     if (entity_storage(e) != storage_undefined) {
       ParserError("DeclareVariable", "storage non implemented\n");
     }
     else {
       entity_storage(e) = s;
     }
   }
  
   if (v == value_undefined) {
     if (entity_initial(e) == value_undefined) {
       entity_initial(e) = make_value_unknown();
     }
   }
   else {
     ParserError("DeclareVariable", "value non implemented\n");
   }
  
   AddEntityToDeclarations(e, get_current_module_entity());
  
   /* If the return variable is retyped, the function must be retyped */
  
   if(!type_undefined_p(t) && !storage_undefined_p(entity_storage(e)) 
      && storage_return_p(entity_storage(e))) {
     entity f = get_current_module_entity();
     type tf = entity_type(f);
     functional func = type_functional(tf);
     type tr = functional_result(func);
     basic old = variable_basic(type_variable(tr));
     basic new = variable_basic(type_variable(t));
  
     pips_assert("Return variable and function must have the same name",
                 strcmp(entity_local_name(e), module_local_name(f)) == 0 );
     pips_assert("Function must have functional type", type_functional_p(tf));
     pips_assert("New type must be of kind variable", type_variable_p(t));
  
     if(!type_equal_p(tr, t)) {
       if(variable_had_implicit_type_p) {
         debug(8, "DeclareVariable", " Type for result of function %s "
               "changed from %s to %s: ", module_local_name(f),
               basic_to_string(old), basic_to_string(new));
         free_type(functional_result(func));
         old = basic_undefined; /* the pointed area has just been freed! */
         functional_result(func) = copy_type(t);
         ifdebug(8) {
           fprint_functional(stderr, type_functional(tf));
           fprintf(stderr, "\n");
         }
       }
       else {
         user_warning("DeclareVariable",
                      "Attempt to retype function %s with result of type "
                      "%s with new type %s\n", module_local_name(f),
                      basic_to_string(old), basic_to_string(new));
         ParserError("DeclareVariable", "Illegal retyping");
       }
     }
     else {
       /* Meaningless warning when the result variable is declared the first time
        * with the function itself
        * user_warning("DeclareVariable",
        *             "Attempt to retype function %s with result of type "
        *             "%s with very same type %s\n", module_local_name(f),
        *             basic_to_string(old), basic_to_string(new));
        */
     }
   }
 }

References AddEntityToDeclarations(), basic_to_string(), basic_type_size(), basic_undefined, copy_basic(), copy_type(), debug(), entity_initial, entity_local_name(), entity_name, entity_storage, entity_type, f(), formal_label_replacement_p(), fprint_functional(), fprintf(), free_type(), functional_result, get_current_module_entity(), ifdebug, implicit_type_p(), ImplicitType(), is_type_area, is_type_functional, is_type_variable, line_b_I, line_e_I, list_undefined, make_value_unknown(), MakeTypeVariable(), module_local_name(), NIL, ParserError(), pips_assert, pips_internal_error, pips_user_warning, same_basic_and_scalar_p(), storage_ram_p, storage_return_p, storage_undefined, storage_undefined_p, type_equal_p(), type_functional, type_functional_p, type_tag, type_undefined, type_undefined_p, type_variable, type_variable_p, user_warning, value_undefined, variable_basic, and variable_dimensions.

Referenced by AddVariableToCommon(), DeclarePointer(), MakeAssignedGotoInst(), MakeAtom(), MakeCurrentFunction(), and SaveEntity().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ dump_current_statement()

void dump_current_statement ( void )

Preprocessed statement: Spaces have been eliminated as well as continuation lines, keyword have been emphasized and variables capitalized.

Skip the initial lines

line_b_I, line_e_I

Copy the data lines

Definition at line 1354 of file reader.c.

 {
   int i;
   FILE * syn_in = NULL;
  
   /* Preprocessed statement: Spaces have been eliminated as well as
      continuation lines, keyword have been emphasized and variables
      capitalized. */
   /*
   for(i=0; i<lStmt; i++)
     fprintf(stderr, "%c", (char) stmt_buffer[i]);
   fprintf(stderr,"\n");
   */
  
   syn_in = safe_fopen(CurrentFN, "r");
  
   /* Skip the initial lines */
  
   /* line_b_I, line_e_I */
   i = 1;
   while(i<line_b_I) {
     int c;
     if((c = getc(syn_in))==(int) '\n') i++;
     pips_assert("The end of file cannot be reached", c!=EOF);
   }
  
   /* Copy the data lines */
   while(i<=line_e_I) {
     int c;
     if((c = getc(syn_in))==(int) '\n') i++;
     pips_assert("The end of file cannot be reached", c!=EOF);
     putc(c, stderr);
   }
  
   safe_fclose(syn_in, CurrentFN);
 }

References CurrentFN, line_b_I, line_e_I, pips_assert, safe_fclose(), safe_fopen(), and syn_in.

Here is the call graph for this function:

◆ empty_current_label_string_p()

bool empty_current_label_string_p ( void )

Definition at line 87 of file parser.c.

 {
     bool empty_p = same_string_p(lab_I, "");
  
     return empty_p;
 }

References lab_I, and same_string_p.

Referenced by MakeElseInst().

Here is the caller graph for this function:

◆ EmptyEntryListsP()

bool EmptyEntryListsP ( void )

Definition at line 1506 of file procedure.c.

 {
     bool empty = ((entry_labels==NIL) && (entry_entities==NIL));
  
     return empty;
 }

References empty, entry_entities, entry_labels, and NIL.

Referenced by EndOfProcedure(), MakeEntry(), and the_actual_parser().

Here is the caller graph for this function:

◆ EndOfProcedure()

void EndOfProcedure ( void )

This function is called when the parsing of a procedure is completed.

It performs a few calculations which cannot be done on the fly such as address computations for static and dynamic areas and commons.

And it writes the internal representation of the CurrentFunction with a call to gen_free (?).

get rid of ghost variable entities and substitute them if necessary

we generate the last statement to carry a label or a comment

|| iPrevComm != 0

we generate statement last+1 to eliminate returns

Check the block stack

are there undefined gotos ?

The following calls could be located in check_first_statement() which is called when the first executable statement is encountered. At that point, many declaration related problems should be fixed or fixeable. But additional undeclared variables will be added to the dynamic area and their addresses must be computed. At least, ComputeAddresses() must stay here.. so I keep all these calls together.

Must be performed before equivalence resolution, for user declared commons whose declarations are stronger than equivalences

Use equivalence chains to update storages of equivalenced and of variables implicitly declared in DynamicArea, or implicitly thru DATA or explicitly thru SAVE declared in StaticArea

Initialize the shared field in ram storage

Now that retyping and equivalences have been taken into account:

Why keep it in (apparent) declaration order rather than alphabetical order? Because some later processing may be based on this assumption. Sort can be performed before printouts.

remove hpfc special routines if required.

done here. affects callees and code. FC.

the current package is re-initialized

Definition at line 979 of file procedure.c.

 {
     entity CurrentFunction = get_current_module_entity();
  
     pips_debug(8, "Begin for module %s\n",
           entity_name(CurrentFunction));
  
     pips_debug(8, "checking code consistency = %d\n",
                statement_consistent_p( function_body )) ;
  
     ifdebug(8) {
         pips_debug(8, "Declarations inherited from module %s:\n",
                    module_local_name(CurrentFunction));
         dump_arguments(entity_declarations(CurrentFunction));
     }
  
     /* get rid of ghost variable entities and substitute them if necessary */
     remove_ghost_variable_entities(true);
  
     /* we generate the last statement to carry a label or a comment */
     if (strlen(lab_I) != 0 /* || iPrevComm != 0 */ ) {
         LinkInstToCurrentBlock(make_continue_instruction(), false);
     }
  
     /* we generate statement last+1 to eliminate returns */
     GenerateReturn();
  
     uses_alternate_return(false);
     ResetReturnCodeVariable();
     SubstituteAlternateReturns("NO");
  
     /* Check the block stack */
     (void) PopBlock() ;
     if (!IsBlockStackEmpty())
             ParserError("EndOfProcedure",
                         "bad program structure: missing ENDDO and/or ENDIF\n");
  
     /* are there undefined gotos ? */
     CheckAndInitializeStmt();
  
     /* The following calls could be located in check_first_statement()
      * which is called when the first executable statement is
      * encountered. At that point, many declaration related
      * problems should be fixed or fixeable. But additional
      * undeclared variables will be added to the dynamic area
      * and their addresses must be computed. At least, ComputeAddresses()
      * must stay here.. so I keep all these calls together.
      */
     UpdateFunctionalType(CurrentFunction,
                          FormalParameters);
  
     process_static_initializations();
  
     /* Must be performed before equivalence resolution, for user declared
        commons whose declarations are stronger than equivalences */
     update_user_common_layouts(CurrentFunction);
  
     ComputeEquivalences();
     /* Use equivalence chains to update storages of equivalenced and of
        variables implicitly declared in DynamicArea, or implicitly thru
        DATA or explicitly thru SAVE declared in StaticArea */
     ComputeAddresses();
  
     /* Initialize the shared field in ram storage */
     SaveChains();
  
     /* Now that retyping and equivalences have been taken into account: */
     update_common_sizes();
  
     /* Why keep it in (apparent) declaration order rather than
        alphabetical order? Because some later processing may be based on
        this assumption. Sort can be performed before printouts. */
     code_declarations(EntityCode(CurrentFunction)) =
             gen_nreverse(code_declarations(EntityCode(CurrentFunction))) ;
  
     if (get_bool_property("PARSER_DUMP_SYMBOL_TABLE"))
         fprint_environment(stderr, CurrentFunction);
  
     ifdebug(5){
         fprintf(stderr, "Parser: checking callees consistency = %d\n",
                 callees_consistent_p( make_callees( called_modules ))) ;
     }
  
     /*  remove hpfc special routines if required.
      */
     if (get_bool_property("HPFC_FILTER_CALLEES"))
     {
         list l = NIL;
         string s;
  
         MAPL(cs,
          {
              s = STRING(CAR(cs));
  
              if (hpf_directive_string_p(s) && !keep_directive_in_code_p(s))
              {
                  pips_debug(3, "ignoring %s\n", s);
              }
              else
                  l = CONS(STRING, s, l);
          },
              called_modules);
  
         gen_free_list(called_modules);
         called_modules = l;
     }
  
     /* done here. affects callees and code. FC.
      */
     parser_substitute_all_macros(function_body);
     parser_close_macros_support();
  
     if(!EmptyEntryListsP()) {
         set_current_module_statement(function_body);
         ProcessEntries();
         reset_current_module_statement();
     }
  
     reset_common_size_map();
  
     DB_PUT_MEMORY_RESOURCE(DBR_CALLEES,
                            module_local_name(CurrentFunction),
                            (char*) make_callees(called_modules));
  
     pips_debug(5, "checking code consistency = %d\n",
                 statement_consistent_p( function_body )) ;
  
     DB_PUT_MEMORY_RESOURCE(DBR_PARSED_CODE,
                            module_local_name(CurrentFunction),
                            (char *)function_body);
  
     /* the current package is re-initialized */
     CurrentPackage = TOP_LEVEL_MODULE_NAME;
     ResetChains();
     DynamicArea = entity_undefined;
     StaticArea = entity_undefined;
     reset_current_module_entity();
  
     pips_debug(5, "checking code consistency after resettings = %d\n",
                 statement_consistent_p( function_body )) ;
  
     pips_debug(8, "End for module %s\n", entity_name(CurrentFunction));
 }

References called_modules, callees_consistent_p(), CAR, CheckAndInitializeStmt(), code_declarations, ComputeAddresses(), ComputeEquivalences(), CONS, CurrentPackage, DB_PUT_MEMORY_RESOURCE, dump_arguments(), DynamicArea, EmptyEntryListsP(), entity_declarations, entity_name, entity_undefined, EntityCode(), FormalParameters, fprint_environment(), fprintf(), function_body, gen_free_list(), gen_nreverse(), GenerateReturn(), get_bool_property(), get_current_module_entity(), hpf_directive_string_p(), ifdebug, IsBlockStackEmpty(), keep_directive_in_code_p(), lab_I, LinkInstToCurrentBlock(), make_callees(), make_continue_instruction(), MAPL, module_local_name(), NIL, parser_close_macros_support(), parser_substitute_all_macros(), ParserError(), pips_debug, PopBlock(), process_static_initializations(), ProcessEntries(), remove_ghost_variable_entities(), reset_common_size_map(), reset_current_module_entity(), reset_current_module_statement(), ResetChains(), ResetReturnCodeVariable(), SaveChains(), set_current_module_statement(), statement_consistent_p(), StaticArea, STRING, SubstituteAlternateReturns(), TOP_LEVEL_MODULE_NAME, update_common_sizes(), update_user_common_layouts(), UpdateFunctionalType(), and uses_alternate_return().

Here is the call graph for this function:

◆ entity_in_equivalence_chain_p()

bool entity_in_equivalence_chain_p	(	entity	e,
		chain	c
	)

Definition at line 420 of file equivalence.c.

 {
     cons *pca;
     atom a;
     bool is_in_p = false;
  
     pips_debug(9, "Begin for entity %s \n", entity_name(e));
  
     for (pca = chain_atoms(c); !ENDP(pca) && !is_in_p; POP(pca)) {
         a = ATOM(CAR(pca));
  
         is_in_p = (atom_equivar(a) == e);
     }
     pips_debug(9, "End\n");
     return is_in_p;
 }

References ATOM, atom_equivar, CAR, chain_atoms, ENDP, entity_name, pips_debug, and POP.

Referenced by entity_in_equivalence_chains_p().

Here is the caller graph for this function:

◆ entity_in_equivalence_chains_p()

bool entity_in_equivalence_chains_p ( entity e )

Apparently, TempoEquivSet stays undefined when there are no equivalences

Definition at line 403 of file equivalence.c.

 {
     equivalences equiv = TempoEquivSet;
     list pcc;
     bool is_in_p = false;
  
     /* Apparently, TempoEquivSet stays undefined when there are no equivalences */
     if(!equivalences_undefined_p(equiv)) {
         for (pcc = equivalences_chains(equiv); !ENDP(pcc) && !is_in_p; POP(pcc)) {
             is_in_p = entity_in_equivalence_chain_p(e, CHAIN(CAR(pcc)));
         }
     }
  
     return is_in_p;
 }

References CAR, CHAIN, ENDP, entity_in_equivalence_chain_p(), equivalences_chains, equivalences_undefined_p, POP, and TempoEquivSet.

Referenced by remove_ghost_variable_entities().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindAssign()

int FindAssign ( void )

Definition at line 1197 of file reader.c.

 {
     int result = false;
  
     if (!ProfZeroEgal && StmtEqualString("ASSIGN", iStmt)) {
         register size_t i = iStmt+6;
  
         if (isdigit(stmt_buffer[i])) {
             while (i < lStmt && isdigit(stmt_buffer[i]))
                 i++;
  
             if (StmtEqualString("TO", i)) {
                 (void) CapitalizeStmt("ASSIGN", iStmt);
                 (void) CapitalizeStmt("TO", i);
                 result = true;
             }
         }
     }
  
     return(result);
 }

References CapitalizeStmt(), iStmt, lStmt, ProfZeroEgal, stmt_buffer, and StmtEqualString().

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindAutre()

void FindAutre ( void )

Definition at line 1169 of file reader.c.

 {
     if (!ProfZeroEgal) {
         int i = NeedKeyword();
  
         /*
          * on detecte le cas tordu: INTEGER FUNCTION(...) ou encore
          * plus tordu: CHARACTER*89 FUNCTION(...)
          */
         if (StmtEqualString("Integer", iStmt) ||
             StmtEqualString("Real", iStmt) ||
             StmtEqualString("Character", iStmt) ||
             StmtEqualString("Complex", iStmt) ||
             StmtEqualString("Doubleprecision", iStmt) ||
             StmtEqualString("Logical", iStmt)) {
             if (stmt_buffer[i] == '*' && isdigit(stmt_buffer[i+1])) {
                 i += 2;
                 while (isdigit(stmt_buffer[i]))
                     i++;
             }
             if (StmtEqualString("FUNCTION", i)) {
                 (void) CapitalizeStmt("FUNCTION", i);
             }
         }
     }
 }

References CapitalizeStmt(), iStmt, NeedKeyword(), ProfZeroEgal, stmt_buffer, and StmtEqualString().

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindDo()

int FindDo ( void )

Let's skip a loop label to look for a while construct

Definition at line 1087 of file reader.c.

 {
     int result = false;
  
     if(StmtEqualString("DO", iStmt)) {
         if (ProfZeroVirg && ProfZeroEgal) {
             (void) CapitalizeStmt("DO", iStmt);
             result = true;
         }
         else if (!ProfZeroVirg && !ProfZeroEgal) {
             /* Let's skip a loop label to look for a while construct */
             int i = iStmt+2;
             while (isdigit(stmt_buffer[i]))
                 i++;
  
             if (StmtEqualString("WHILE", i)) {
                 (void) CapitalizeStmt("DO", iStmt);
                 (void) CapitalizeStmt("WHILE", i);
                 result = true;
             }
         }
     }
  
     return(result);
 }

References CapitalizeStmt(), iStmt, ProfZeroEgal, ProfZeroVirg, stmt_buffer, and StmtEqualString().

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindDoWhile()

int FindDoWhile ( void )

This function is redundant with FindDo() but much easier to understand.

I leave it as documentation. FI.

Definition at line 1073 of file reader.c.

 {
     int result = false;
  
     if (!ProfZeroEgal && StmtEqualString("DOWHILE", iStmt)) {
         (void) CapitalizeStmt("DO", iStmt);
         (void) CapitalizeStmt("WHILE", iStmt+2);
         result = true;
     }
  
     return(result);
 }

References CapitalizeStmt(), iStmt, ProfZeroEgal, and StmtEqualString().

Here is the call graph for this function:

◆ FindIf()

void FindIf ( void )

Definition at line 1150 of file reader.c.

 {
     if (StmtEqualString("IF(", iStmt)) {
         int i = FindMatchingPar(iStmt+2)+1;
         if (stmt_buffer[i] != '=') {
             (void) CapitalizeStmt("IF", iStmt);
             iStmt = i;
         }
     }
     else if (StmtEqualString("ELSEIF(", iStmt)) {
         int i = FindMatchingPar(iStmt+6)+1;
         if (stmt_buffer[i] != '=') {
             (void) CapitalizeStmt("ELSEIF", iStmt);
             iStmt = i;
         }
     }
 }

References CapitalizeStmt(), FindMatchingPar(), iStmt, stmt_buffer, and StmtEqualString().

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindIfArith()

int FindIfArith ( void )

Definition at line 1134 of file reader.c.

 {
     int result = false;
  
     if (StmtEqualString("IF(", iStmt)) {
         int i = FindMatchingPar(iStmt+2)+1;
         if ('0' <= stmt_buffer[i] && stmt_buffer[i] <= '9') {
             (void) CapitalizeStmt("IF", iStmt);
             result = true;
         }
     }
  
     return(result);
 }

References CapitalizeStmt(), FindMatchingPar(), iStmt, stmt_buffer, and StmtEqualString().

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindImplicit()

int FindImplicit ( void )

Definition at line 1114 of file reader.c.

 {
     int result = false;
  
     if (!ProfZeroEgal && StmtEqualString("IMPLICIT", iStmt)) {
         iStmt = CapitalizeStmt("IMPLICIT", iStmt);
         while (iStmt < lStmt) {
             iStmt = NeedKeyword();
             if ((iStmt = FindProfZero((int) ',')) == SIZE_UNDEF)
                 iStmt = lStmt;
             else
                 iStmt += 1;
         }
         result = true;
     }
  
     return(result);
 }

References CapitalizeStmt(), FindProfZero(), iStmt, lStmt, NeedKeyword(), ProfZeroEgal, SIZE_UNDEF, and StmtEqualString().

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindMatchingPar()

size_t FindMatchingPar ( size_t i )

Definition at line 1267 of file reader.c.

 {
     int parenthese;
  
     pips_assert("FindMatchingPar", 
                 stmt_buffer[i] == '(' && !IS_QUOTED(stmt_buffer[i]));
  
     i += 1;
     parenthese = 1;
  
     while (i < lStmt && parenthese > 0) {
         if (!IS_QUOTED(stmt_buffer[i])) {
             if(stmt_buffer[i] == '(') parenthese ++;
             if(stmt_buffer[i] == ')') parenthese --;
         }
         i += 1;
     }
  
     return (i == lStmt) ? SIZE_UNDEF : i-1;
 }

References IS_QUOTED, lStmt, pips_assert, SIZE_UNDEF, and stmt_buffer.

Referenced by FindIf(), and FindIfArith().

Here is the caller graph for this function:

◆ FindPoints()

void FindPoints ( void )

Definition at line 1220 of file reader.c.

 {
     register size_t i = iStmt;
  
     while (i < lStmt) {
         if (stmt_buffer[i] == '.' && isalpha(stmt_buffer[i+1])) {
             register int j = 0;
  
             while (OperateurPoints[j] != NULL) {
                 if (StmtEqualString(OperateurPoints[j], i)) {
                     stmt_buffer[i] = '%';
                     i += strlen(OperateurPoints[j]);
                     stmt_buffer[i-1] = '%';
                     break;
                 }
                 j += 1;
             }
  
             if (OperateurPoints[j] == NULL)
                 i += 2;
         }
         else {
             i += 1;
         }
     }
 }

References iStmt, lStmt, OperateurPoints, stmt_buffer, and StmtEqualString().

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ FindProfZero()

size_t FindProfZero ( int c )

Definition at line 1248 of file reader.c.

 {
     register size_t i;
     int parenthese = 0;
  
     for (i = iStmt; i < lStmt; i++) {
         if (!IS_QUOTED(stmt_buffer[i])) {
             if (parenthese == 0 && stmt_buffer[i] == c)
                 break;
  
             if(stmt_buffer[i] == '(') parenthese ++;
             if(stmt_buffer[i] == ')') parenthese --;
         }
     }
  
     return (i == lStmt) ? SIZE_UNDEF : i;
 }

References IS_QUOTED, iStmt, lStmt, SIZE_UNDEF, and stmt_buffer.

Referenced by FindImplicit().

Here is the caller graph for this function:

◆ first_executable_statement_seen()

bool first_executable_statement_seen ( void )

Definition at line 1964 of file statement.c.

 {
     return seen;
 }

References seen.

◆ first_format_statement_seen()

bool first_format_statement_seen ( void )

Definition at line 1970 of file statement.c.

 {
     return format_seen;
 }

References format_seen.

◆ fix_if_condition()

expression fix_if_condition ( expression e )

with the f77 compiler, this is equivalent to e.NE.0 if e is an integer expression.

Definition at line 1293 of file statement.c.

 {
   expression cond = expression_undefined;
  
   if(!logical_expression_p(e)) {
     /* with the f77 compiler, this is equivalent to e.NE.0 if e is an
        integer expression. */
     if(integer_expression_p(e)) {
       cond = MakeBinaryCall(entity_intrinsic(NON_EQUAL_OPERATOR_NAME),
                             e, int_to_expression(0));
       pips_user_warning("IF condition between lines %d and %d is not a logical expression.\n",
                         line_b_I,line_e_I);
     }
     else {
       ParserError("MakeBlockIfInst", "IF condition is neither logical nor integer.\n");
     }
   }
   else {
     cond = e;
   }
   return cond;
 }

References entity_intrinsic(), expression_undefined, int_to_expression(), integer_expression_p(), line_b_I, line_e_I, logical_expression_p(), MakeBinaryCall(), NON_EQUAL_OPERATOR_NAME, ParserError(), and pips_user_warning.

Referenced by MakeBlockIfInst(), and MakeLogicalIfInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ fortran_relevant_area_entity_p()

bool fortran_relevant_area_entity_p ( entity c )

These tests are needed to check area consistency when dumping or printing a symbol table.

Definition at line 940 of file declaration.c.

 {
   return ((common_size_map == hash_table_undefined || common_to_size(c)==0)
          && !heap_area_p(c)
           && !stack_area_p(c));
 }

References common_size_map, common_to_size(), hash_table_undefined, heap_area_p(), and stack_area_p().

Here is the call graph for this function:

◆ FortranExpressionList()

list FortranExpressionList ( list l )

Make sure that no call to implied do is in l.

Definition at line 492 of file expression.c.

 {
     MAP(EXPRESSION, e, {
         if(expression_implied_do_p(e))
             ParserError("FortranExpressionList", "Unexpected implied DO\n");
     }, l);
     return l;
 }

References EXPRESSION, expression_implied_do_p(), MAP, and ParserError().

Here is the call graph for this function:

◆ generate_return_code_checks()

instruction generate_return_code_checks ( list labels )

The reset is controlled from gram.y, as is the set

reset_alternate_returns();

ifdebug(2) {

pips_debug(2, "Additional statement generated for hide_rc_p:\n");

print_statement(s_init_rcv);

}

Parameters

labels abels

Definition at line 337 of file return.c.

 {
     instruction i = instruction_undefined;
     list lln = NIL;
     entity rcv = GetFullyDefinedReturnCodeVariable();
     expression ercv = expression_undefined;
  
     pips_assert("The label list is not empty", !ENDP(labels));
  
  
  
     ercv = entity_to_expression(rcv);
  
     FOREACH(ENTITY, l, labels) {
         lln = CONS(STRING, (char*)label_local_name(l), lln);
     }
  
     i = MakeComputedGotoInst(lln, ercv);
  
     /* The reset is controlled from gram.y, as is the set */
     /* reset_alternate_returns(); */
     gen_free_list(lln);
  
     instruction_consistent_p(i);
  
     if(hide_rc_p) {
       statement s_init_rcv = make_get_rc_statement(entity_to_expression(rcv));
  
       /* ifdebug(2) { */
       /*        pips_debug(2, "Additional statement generated for hide_rc_p:\n"); */
       /*        print_statement(s_init_rcv); */
       /*        } */
       pips_assert("i is a sequence", instruction_block_p(i));
       instruction_block(i) = CONS(STATEMENT, s_init_rcv, instruction_block(i));
       instruction_consistent_p(i);
     }
  
     return i;
 }

References CONS, ENDP, ENTITY, entity_to_expression(), expression_undefined, FOREACH, gen_free_list(), GetFullyDefinedReturnCodeVariable(), hide_rc_p, instruction_block, instruction_block_p, instruction_consistent_p(), instruction_undefined, label_local_name(), make_get_rc_statement(), MakeComputedGotoInst(), NIL, pips_assert, STATEMENT, and STRING.

Referenced by MakeCallInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ GenerateReturn()

void GenerateReturn ( void )

Generate a unique call to RETURN per module.

statement c = MakeStatement(l, make_continue_instruction());

Definition at line 499 of file return.c.

 {
     instruction inst = instruction_undefined;
     /* statement c = MakeStatement(l, make_continue_instruction()); */
  
  
     if(substitute_rc_p && uses_alternate_return_p()) {
         entity l = MakeLabel(strdup(end_label_local_name));
         expression rc = int_to_expression(0);
         statement src = make_set_rc_statement(rc);
         statement jmp = statement_undefined;
             (MakeZeroOrOneArgCallInst("RETURN", expression_undefined));
  
         statement_number(src) = get_statement_number();
         jmp = MakeStatement(l, MakeZeroOrOneArgCallInst("RETURN", expression_undefined));
         /*
         statement_number(jmp) = get_statement_number();
         (void) get_next_statement_number();
         */
         inst = make_instruction_block(CONS(STATEMENT, src, CONS(STATEMENT, jmp, NIL)));
         instruction_consistent_p(inst);
     }
     else {
         strcpy(lab_I, end_label_local_name);
         inst = MakeZeroOrOneArgCallInst("RETURN", expression_undefined);
     }
  
     LinkInstToCurrentBlock(inst, true);
 }

References CONS, end_label_local_name, expression_undefined, get_statement_number(), instruction_consistent_p(), instruction_undefined, int_to_expression(), lab_I, LinkInstToCurrentBlock(), make_instruction_block(), make_set_rc_statement(), MakeLabel(), MakeStatement(), MakeZeroOrOneArgCallInst(), NIL, src, STATEMENT, statement_number, statement_undefined, strdup(), substitute_rc_p, and uses_alternate_return_p().

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ get_alternate_returns()

list get_alternate_returns ( void )

Definition at line 258 of file return.c.

 {
     return alternate_returns;
 }

References alternate_returns.

Referenced by add_actual_return_code(), and MakeCallInst().

Here is the caller graph for this function:

◆ get_current_label_string()

string get_current_label_string ( void )

Definition at line 76 of file parser.c.

 {
     return lab_I;
 }

References lab_I.

Referenced by MakeElseInst().

Here is the caller graph for this function:

◆ get_current_number_of_alternate_returns()

int get_current_number_of_alternate_returns ( void )

Definition at line 197 of file return.c.

 {
   return current_number_of_alternate_returns;
 }

References current_number_of_alternate_returns.

◆ get_statement_number()

int get_statement_number ( void )

eturn the line number of the statement being parsed

Definition at line 1392 of file reader.c.

                             {
   return StmtLineNumber - 1;
 }

References StmtLineNumber.

Referenced by GenerateReturn(), make_get_rc_statement(), MakeArithmIfInst(), MakeAssignedOrComputedGotoInst(), MakeCallInst(), MakeLogicalIfInst(), MakeNewLabelledStatement(), MakeReturn(), MakeStatement(), and ReuseLabelledStatement().

Here is the caller graph for this function:

◆ GetChar()

int GetChar ( FILE * fp )

Routine de lecture physique.

In case an error occurs, buffer must be emptied. Since i_getchar and l_getchar cannot be touched by the error handling routine, changes of fp are tracked in GetChar() and dynamically tested. Kludge suggested by Fabien Coelho to avoid adding more global variables. (FI)

Empty (or rather invisible) lines made of TAB and SPACE characters are replaced by the string "\n".

This section (probably) is made obsolete by the new function parser_reset_all_reader_buffers(). The user_warning() is replaced by a pips_error(). Test: Cachan/bug10

If a file has just been opened

if the buffer is not empty, which may never occur if previous_fp == NULL, perform a buffer reset

A whole input line is read to process TABs and empty lines

large for expansion

Fortran has a limited character set. See standard section 3.1. This cannot be handled here as you do not know if you are in a string constant or not. You cannot convert the double quote into a simple quote because you may generate an illegal string constant. Maybe the best would be to uncomment the next test. FI, 21 February 1992 if( c == '"') FatalError("GetChar","Illegal double quote character"); "

FI: let's delay and do it in ReadLine: if (islower(c)) c = toupper(c);

for (i = 0; i < (8-Column%8); i++) {

Ignore carriage returns introduced by VMS, MSDOS or MACOS...

buffer[l_getchar++] = (col > 72) ? ' ' : c;

buffer[l_getchar++] = (col > 72) ? '
' : c;

last columns cannot be copied because we might be inside a character string

i_getchar = l_getchar = UNDEF;

LineNumber += 1;

Parameters

fp p

Definition at line 614 of file reader.c.

 {
     int c = UNDEF;
     static int col = 0;
     static FILE * previous_fp = NULL;
  
     init_getchar_buffer();
  
     /* This section (probably) is made obsolete by the new function 
      * parser_reset_all_reader_buffers(). The user_warning() is replaced
      * by a pips_error(). Test: Cachan/bug10
      */
     if( previous_fp != fp ) {
         /* If a file has just been opened */
         if( i_getchar < l_getchar ) {
             /* if the buffer is not empty, which may never occur if 
              * previous_fp == NULL, perform a buffer reset
              */
             i_getchar = l_getchar;
             pips_internal_error("Unexpected buffer reset."
                        "A parser error must have occured previously.\n");
         }
         previous_fp = fp;
     }
  
     /* A whole input line is read to process TABs and empty lines */
     while (i_getchar >= l_getchar && c != EOF) {
         int EmptyBuffer = true;
         int LineTooLong = false;
         bool first_column = true;
         bool in_comment = false;
  
         i_getchar = l_getchar = 0;
  
         while ((c = getc(fp)) != '\n' && c != EOF) {
  
             if (l_getchar>getchar_buffer_size-20) /* large for expansion */
                 resize_getchar_buffer();
  
             if(first_column) {
                 in_comment = (strchr(START_COMMENT_LINE, (char) c)!= NULL);
                 first_column = false;
             }
  
             /* Fortran has a limited character set. See standard section 3.1.
                This cannot be handled here as you do not know if you are
                in a string constant or not. You cannot convert the double
                quote into a simple quote because you may generate an illegal
                string constant. Maybe the best would be to uncomment the
                next test. FI, 21 February 1992 
             if( c == '\"')
                 FatalError("GetChar","Illegal double quote character");
                 " */
             /* FI: let's delay and do it in ReadLine:
              * if (islower(c)) c = toupper(c);
              */
  
             if (c == '\t') {
                 int i;
                 int nspace = 8-col%8;
                 /* for (i = 0; i < (8-Column%8); i++) { */
                 for (i = 0; i < nspace; i++) {
                     col += 1;
                     getchar_buffer[l_getchar++] = ' ';
                 }
             } else if (c == '\r') {
                 /* Ignore carriage returns introduced by VMS, MSDOS or MACOS...*/
                 ;
             }
             else {
                 col += 1;
                 if(col > 72 && !LineTooLong && !in_comment && 
                    parser_warn_for_columns_73_80 && !(c==' ' || c=='\t')) {
                     user_warning("GetChar",
                                  "Line %d truncated, col=%d and l_getchar=%d\n",
                                  LineNumber, col, l_getchar);
                     LineTooLong = true;
                 }
                 /* buffer[l_getchar++] = (col > 72) ? ' ' : c; */
                 /* buffer[l_getchar++] = (col > 72) ? '\n' : c; */
                 if(col <= 72 || in_comment) {
                   /* last columns cannot be copied because we might be 
                    * inside a character string
                    */
                   getchar_buffer[l_getchar++] = c;
                 }
                 if (c != ' ')
                     EmptyBuffer = false;
             }
         }
                 
         if (c == EOF) {
             if (!EmptyBuffer) {
                 user_warning("GetChar",
                              "incomplete last line !!!\n");
                 c = '\n';
             }
         }
         else {
             if (EmptyBuffer) {
                 /* i_getchar = l_getchar = UNDEF; */
                 debug(8, "GetChar", "An empty line has been detected\n");
                 i_getchar = l_getchar = 0;
                 getchar_buffer[l_getchar++] = '\n';
                 col = 0;
                 /* LineNumber += 1; */
             }
             else {
                 col = 0;
                 getchar_buffer[l_getchar++] = '\n';
             }
         }
         ifdebug(8) {
             int i;
  
             if(l_getchar==UNDEF) {
                 debug(8, "GetChar",
                       "Input line after tab expansion is empty:\n");
             }
             else {
                 debug(8, "GetChar",
                       "Input line after tab expansion l_getchar=%d, col=%d:\n",
                       l_getchar, col);
             }
             for (i=0; i < l_getchar; i++) {
                 (void) putc((char) getchar_buffer[i], stderr);
             }
             if(l_getchar<=0) {
                 (void) putc('\n', stderr);
             }
         }
     }
  
     if (c != EOF) {
         if ((c = getchar_buffer[i_getchar++]) == '\n') {
             Column = 1;
             LineNumber += 1;
         }
         else {
             Column += 1;
         }
     }
  
     return(c);
 }

References Column, debug(), getchar_buffer, getchar_buffer_size, i_getchar, ifdebug, init_getchar_buffer(), l_getchar, LineNumber, parser_warn_for_columns_73_80, pips_internal_error, resize_getchar_buffer(), START_COMMENT_LINE, UNDEF, and user_warning.

Referenced by ReadLine().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ GetReturnCodeVariable()

entity GetReturnCodeVariable ( void )

Cannot be asserted because the return_code_variable may either be a formal parameter if the current module uses multiple return, or a dynamic variable if it does not and if it calls a subroutine using alternate returns

Definition at line 95 of file return.c.

 {
   const char* rc_name = get_string_property("PARSER_RETURN_CODE_VARIABLE");
   /* Cannot be asserted because the return_code_variable may either be a
    * formal parameter if the current module uses multiple return, or
    * a dynamic variable if it does not and if it calls a subroutine
    * using alternate returns
    */
   /*
     pips_assert("entity return_code_variable is undefined",
     entity_undefined_p(return_code_variable));
   */
   return_code_variable = FindEntity(get_current_module_name(), rc_name);
   if(entity_undefined_p(return_code_variable)) {
     return_code_variable = FindOrCreateEntity(get_current_module_name(), rc_name);
   }
  
   return return_code_variable;
 }

References entity_undefined_p, FindEntity(), FindOrCreateEntity(), get_current_module_name(), get_string_property(), and return_code_variable.

Referenced by add_formal_return_code(), GetFullyDefinedReturnCodeVariable(), and make_set_rc_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ghost_variable_entity_p()

bool ghost_variable_entity_p ( entity e )

Definition at line 292 of file procedure.c.

 {
     pips_assert("defined list", !list_undefined_p(ghost_variable_entities));
  
     return entity_is_argument_p(e, ghost_variable_entities);
 }

References entity_is_argument_p(), ghost_variable_entities, list_undefined_p, and pips_assert.

Referenced by NameToFunctionalEntity(), and SafeFindOrCreateEntity().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ hpfc_parser()

bool hpfc_parser ( const string module )

parser for HPFC.

just a different input file not to touch the original source file. this parser should be selected/activated automatically.

Parameters

module odule

Definition at line 286 of file parser.c.

 {
     return the_actual_parser(module, DBR_HPFC_FILTERED_FILE);
 }

References module, and the_actual_parser().

Here is the call graph for this function:

◆ implicit_type_p()

bool implicit_type_p ( entity e )

This function checks that entity e has an undefined or an implicit type which can be superseded by another declaration.

The first letter of e's name is used to determine the implicit type. The implicit type of a functional entity is its result type.

ASSERT

to please gcc

Definition at line 1358 of file declaration.c.

 {
     int i;
     const char* s = entity_local_name(e);
     type t = entity_type(e);
     basic b;
  
     if(t == type_undefined)
         return true;
  
     if(type_functional_p(t))
         t = functional_result(type_functional(t));
  
     if (s[0] == '_')
             s++;
     if (!(IS_UPPER((int)s[0]))) {
         pips_internal_error("bad name: %s", s);
         FatalError("implicit_type_p", "\n");
     }
     i = (int) (s[0] - 'A');
  
     /* ASSERT */
     if (!type_variable_p(t))
         pips_internal_error("expecting a variable for %s, got tag %d",
                             entity_name(e), type_tag(t));
  
     b = variable_basic(type_variable(t));
  
     if((tag)basic_tag(b) != tag_implicit[i])
         return false;
  
     switch(basic_tag(b)) {
         case is_basic_int: return (size_t)basic_int(b)==int_implicit[i];
         case is_basic_float: return (size_t)basic_float(b)==int_implicit[i];
         case is_basic_logical: return (size_t)basic_logical(b)==int_implicit[i];
         case is_basic_complex: return (size_t)basic_complex(b)==int_implicit[i];
         case is_basic_overloaded:
             pips_internal_error("unexpected overloaded basic tag");
         case is_basic_string: 
             return (size_t)constant_int(value_constant(basic_string(b)))==
                 int_implicit[i];
         default:
             pips_internal_error("illegal basic tag");
         }
     return false; /* to please gcc */
 }

References basic_complex, basic_float, basic_int, basic_logical, basic_string, basic_tag, constant_int, entity_local_name(), entity_name, entity_type, FatalError, functional_result, int, int_implicit, is_basic_complex, is_basic_float, is_basic_int, is_basic_logical, is_basic_overloaded, is_basic_string, IS_UPPER, pips_internal_error, tag_implicit, type_functional, type_functional_p, type_tag, type_undefined, type_variable, type_variable_p, value_constant, and variable_basic.

Referenced by DeclarePointer(), DeclareVariable(), retype_formal_parameters(), and TypeFunctionalEntity().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ImplicitType()

type ImplicitType ( entity e )

This function computes the Fortran implicit type of entity e.

The first letter of e's name is used.

It should be now called FortranImplicitType()

Definition at line 1311 of file declaration.c.

 {
     int i;
     const char* s = entity_local_name(e);
     type t = type_undefined;
     value v = value_undefined;
  
     if (s[0] == '_')
             s++;
  
     if (!(IS_UPPER((int)s[0]))) {
         pips_internal_error("[ImplicitType] bad name: %s", s);
         FatalError("ImplicitType", "\n");
     }
  
     i = (int) (s[0] - 'A');
  
     switch(tag_implicit[i]) {
     case is_basic_int:
     case is_basic_float:
     case is_basic_logical:
     case is_basic_complex:
         t = MakeTypeVariable(make_basic(tag_implicit[i], (void *) int_implicit[i]), NIL);
         break;
     case is_basic_string:
         v = make_value(is_value_constant,
                        make_constant(is_constant_int, (void *) int_implicit[i]));
         t = MakeTypeVariable(make_basic(tag_implicit[i], v), NIL);
         break;
     case is_basic_overloaded:
         FatalError("ImplicitType", "Unsupported overloaded tag for basic\n");
     default:
         FatalError("ImplicitType", "Illegal tag for basic\n");
     }
     /*
     return(MakeTypeVariable(make_basic(tag_implicit[i], int_implicit[i]), NIL));
     */
     return t;
 }

References entity_local_name(), FatalError, int, int_implicit, is_basic_complex, is_basic_float, is_basic_int, is_basic_logical, is_basic_overloaded, is_basic_string, is_constant_int, IS_UPPER, is_value_constant, make_basic(), make_constant(), make_value(), MakeTypeVariable(), NIL, pips_internal_error, tag_implicit, type_undefined, and value_undefined.

Referenced by AddVariableToCommon(), DeclareVariable(), MakeAtom(), MakeCurrentFunction(), MakeFormalParameter(), MakeParameter(), MakeResultType(), mpi_type_mpi_comm(), mpi_type_mpi_request(), mpi_type_mpi_status(), retype_formal_parameters(), TypeFunctionalEntity(), and UpdateFunctionalType().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ init_ghost_variable_entities()

void init_ghost_variable_entities ( void )

procedure.c

Definition at line 69 of file procedure.c.

 {
     pips_assert("undefined list", list_undefined_p(ghost_variable_entities));
     ghost_variable_entities = NIL;
 }

References ghost_variable_entities, list_undefined_p, NIL, and pips_assert.

◆ init_parser_properties()

void init_parser_properties ( void )

Definition at line 296 of file parser.c.

 {
   init_parser_reader_properties();
 }

References init_parser_reader_properties().

Referenced by the_actual_parser().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ init_parser_reader_properties()

void init_parser_reader_properties ( void )

Definition at line 434 of file reader.c.

 {
     parser_warn_for_columns_73_80 = 
         get_bool_property("PARSER_WARN_FOR_COLUMNS_73_80");
     init_comment_buffers();
 }

References get_bool_property(), init_comment_buffers(), and parser_warn_for_columns_73_80.

Referenced by init_parser_properties().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ InitAreas()

void InitAreas ( void )

Definition at line 100 of file declaration.c.

 {
     DynamicArea = FindOrCreateEntity(CurrentPackage, DYNAMIC_AREA_LOCAL_NAME);
     entity_type(DynamicArea) = make_type(is_type_area, make_area(0, NIL));
     entity_storage(DynamicArea) = make_storage_rom();
     entity_initial(DynamicArea) = make_value_unknown();
     entity_kind(DynamicArea) = ABSTRACT_LOCATION | ENTITY_DYNAMIC_AREA;
     AddEntityToDeclarations(DynamicArea, get_current_module_entity());
     set_common_to_size(DynamicArea, 0);
  
     StaticArea = FindOrCreateEntity(CurrentPackage, STATIC_AREA_LOCAL_NAME);
     entity_type(StaticArea) = make_type(is_type_area, make_area(0, NIL));
     entity_storage(StaticArea) = make_storage_rom();
     entity_initial(StaticArea) = make_value_unknown();
     entity_kind(StaticArea) = ABSTRACT_LOCATION | ENTITY_STATIC_AREA;
     AddEntityToDeclarations(StaticArea, get_current_module_entity());
     set_common_to_size(StaticArea, 0);
  
     HeapArea = FindOrCreateEntity(CurrentPackage, HEAP_AREA_LOCAL_NAME);
     entity_type(HeapArea) = make_type(is_type_area, make_area(0, NIL));
     entity_storage(HeapArea) = make_storage_rom();
     entity_initial(HeapArea) = make_value_unknown();
     entity_kind(HeapArea) = ABSTRACT_LOCATION | ENTITY_HEAP_AREA;
     AddEntityToDeclarations(HeapArea, get_current_module_entity());
     set_common_to_size(HeapArea, 0);
  
     StackArea = FindOrCreateEntity(CurrentPackage, STACK_AREA_LOCAL_NAME);
     entity_type(StackArea) = make_type(is_type_area, make_area(0, NIL));
     entity_storage(StackArea) = make_storage_rom();
     entity_initial(StackArea) = make_value_unknown();
     entity_kind(StackArea) = ABSTRACT_LOCATION | ENTITY_STACK_AREA;
     AddEntityToDeclarations(StackArea, get_current_module_entity());
     set_common_to_size(StackArea, 0);
 }

References ABSTRACT_LOCATION, AddEntityToDeclarations(), CurrentPackage, DYNAMIC_AREA_LOCAL_NAME, DynamicArea, ENTITY_DYNAMIC_AREA, ENTITY_HEAP_AREA, entity_initial, entity_kind, ENTITY_STACK_AREA, ENTITY_STATIC_AREA, entity_storage, entity_type, FindOrCreateEntity(), get_current_module_entity(), HEAP_AREA_LOCAL_NAME, HeapArea, is_type_area, make_area(), make_storage_rom(), make_type(), make_value_unknown(), NIL, set_common_to_size(), STACK_AREA_LOCAL_NAME, StackArea, STATIC_AREA_LOCAL_NAME, and StaticArea.

Referenced by gfc2pips_namespace(), and MakeCurrentFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ initialize_common_size_map()

void initialize_common_size_map ( void )

Definition at line 947 of file declaration.c.

 {
     pips_assert("common_size_map is undefined", 
                 common_size_map == hash_table_undefined);
     common_size_map = hash_table_make(hash_pointer, 0);
 }

References common_size_map, hash_pointer, hash_table_make(), hash_table_undefined, and pips_assert.

Referenced by gfc2pips_namespace(), and MakeCurrentFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ InitImplicit()

void InitImplicit ( void )

this function initializes the data structure used to compute implicit types

Definition at line 1271 of file declaration.c.

 {
     cr_implicit(is_basic_float, DefaultLengthOfBasic(is_basic_float), 'A','H');
     cr_implicit(is_basic_float, DefaultLengthOfBasic(is_basic_float), 'O','Z');
     cr_implicit(is_basic_int, DefaultLengthOfBasic(is_basic_int), 'I','N');
 }

References cr_implicit(), DefaultLengthOfBasic(), is_basic_float, and is_basic_int.

Referenced by BeginingOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ IsBlockStackEmpty()

bool IsBlockStackEmpty ( void )

Definition at line 209 of file statement.c.

 {
   return(CurrentBlock == 0);
 }

References CurrentBlock.

Referenced by EndOfProcedure(), LinkInstToCurrentBlock(), and PopBlock().

Here is the caller graph for this function:

◆ IsBlockStackFull()

bool IsBlockStackFull ( void )

Definition at line 215 of file statement.c.

 {
   return(CurrentBlock == MAXBLOCK);
 }

References CurrentBlock, and MAXBLOCK.

Referenced by PushBlock().

Here is the caller graph for this function:

◆ IsCapKeyword()

int IsCapKeyword ( char * s )

Fonction appelee par sslex sur la reduction de la regle de reconnaissance des mot clefs.

Elle recherche si le mot 's' est un mot clef, retourne sa valeur si oui, et indique une erreur si non.

la chaine s est mise en majuscules

just to avoid a gcc warning

OTREACHED

Definition at line 515 of file reader.c.

 {
     register int i, c;
     char *kwcour, *t;
     char buffer[32];
  
     debug(9, "IsCapKeyword", "%s\n", s);
     
     pips_assert("not too long keyword", strlen(s)<32);
  
     /* la chaine s est mise en majuscules */
     t = buffer;
     while ( (c = *s++) ) {
         if (islower(c))
             c = toupper(c);
         *t++ = c;
     }
     *t = '\0';
  
     i = keywidx[(int) buffer[0]-'A'];
  
     if (i != UNDEF) {
         while ((kwcour = keywtbl[i].keywstr)!=0 && kwcour[0]==buffer[0]) {
             if (strcmp(buffer, kwcour) == 0) {
                 debug(9, "IsCapKeyword", "%s %d\n", kwcour, i);
                 return(keywtbl[i].keywval);
             }
  
             i += 1;
         }
     }
  
     user_warning("IsCapKeyword", "[scanner] keyword expected near %s\n",
                  buffer);
     ParserError("IsCapKeyword", "Missing keyword.\n");
     
     return(-1); /* just to avoid a gcc warning */
     /*NOTREACHED*/
 }

References buffer, debug(), int, keywidx, keywtbl, ParserError(), pips_assert, UNDEF, and user_warning.

Here is the call graph for this function:

◆ IsEffectiveFormalParameterP()

bool IsEffectiveFormalParameterP ( entity f )

Definition at line 1534 of file procedure.c.

 {
     return entity_is_argument_p(f, effective_formal_parameters);
 }

References effective_formal_parameters, entity_is_argument_p(), and f().

Referenced by MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ IsIntegerScalar()

int IsIntegerScalar ( entity e )

FI: should be moved in ri-util; this function returns true if e is a zero dimension variable of basic type integer.

Definition at line 1647 of file declaration.c.

 {
     if (type_variable_p(entity_type(e))) {
         variable a = type_variable(entity_type(e));
  
         if (variable_dimensions(a) == NIL && basic_int_p(variable_basic(a)))
                 return(true);
     }
  
     return(false);
 }

References basic_int_p, entity_type, NIL, type_variable, type_variable_p, variable_basic, and variable_dimensions.

◆ LabelToStmt()

statement LabelToStmt ( string l )

this functions looks up in table StmtHeap for the statement s whose label is l.

Definition at line 94 of file statement.c.

 {
   int i;
  
   for (i = 0; i < CurrentStmt; i++)
     if (strcmp(l, StmtHeap_buffer[i].l) == 0)
       return(StmtHeap_buffer[i].s);
  
   return(statement_undefined);
 }

References CurrentStmt, statement_undefined, and StmtHeap_buffer.

Referenced by make_goto_instruction(), MakeStatement(), and NewStmt().

Here is the caller graph for this function:

◆ LinkInstToCurrentBlock()

void LinkInstToCurrentBlock	(	instruction	i,
		bool	number_it
	)

this function links the instruction i to the current block of statements.

if i is the last instruction of the block (i and the block have the same label), the current block is popped from the stack. in fortran, one instruction migth end more than one block.

A label cannot be used twice

a CONTINUE instruction must be added to carry the label, because blocks cannot be labelled

The above continue is not a user statement an should not be numbered

OK, an argument could be added to MakeStatement()...

decrement_statement_number();

instruction_block(i) = CONS (STATEMENT, c, ls);

pips_assert("Why do you want to number a block?!?", false);

OK, let's be cool and ignore this request to save the caller a test

s = MakeStatement(entity_empty_label(), i);

s = instruction_to_statement(i);

Because of labelled loop desugaring, new_i may be different from i

Only desugared constructs such as labelled loop, computed go to or IO with error handling should produce blocks. Such blocks should be non-empty and not commented.

Sometimes, we generate blocks with only one statement in it. E.g. alternate returns pips_assert("The block has at least two statements", !ENDP(CDR(instruction_block(new_i))));

For keeping pragma attached to a loop attached to it, we have to find the loop instruction within the block

while i is the last instruction of the current block ...

Parameters

number_it umber_it

Definition at line 529 of file statement.c.

 {
     statement s;
     cons * pc;
     entity l = MakeLabel(lab_I);
  
     pips_debug(8, "Begin for instruction %s with label \"%s\"\n",
                instruction_identification(i), &(lab_I[0]));
  
     /* A label cannot be used twice */
     reset_current_label_string();
  
     if (IsBlockStackEmpty())
             ParserError("LinkInstToCurrentBlock", "no current block\n");
  
     if(instruction_block_p(i) && !entity_empty_label_p(l)) {
       /* a CONTINUE instruction must be added to carry the label,
          because blocks cannot be labelled */
         /*
       list ls = instruction_block(i);
       statement c = MakeStatement(l, make_continue_instruction());
       */
       /* The above continue is not a user statement an should not be numbered */
       /* OK, an argument could be added to MakeStatement()... */
         /* decrement_statement_number(); */
  
         /* instruction_block(i) = CONS (STATEMENT, c, ls); */
       if(number_it) {
         /* pips_assert("Why do you want to number a block?!?", false); */
         /* OK, let's be cool and ignore this request to save the caller a test */
         /* s = MakeStatement(entity_empty_label(), i); */
           /* s = instruction_to_statement(i); */
           ;
       }
       else{
           /* s = instruction_to_statement(i); */
           ;
       }
       s = MakeStatement(l, i);
     }
     else {
       s = MakeStatement(l, i);
     }
  
     if (iPrevComm != 0) {
         /* Because of labelled loop desugaring, new_i may be different from i */
         instruction new_i = statement_instruction(s);
         if(instruction_block_p(new_i)) {
             statement fs = statement_undefined; // first statement of the block
             statement ss = statement_undefined; // second statement, if it exist
             statement cs = statement_undefined; // commented statement
  
             /* Only desugared constructs such as labelled loop, computed go to or IO with
              * error handling should produce blocks. Such blocks should be
              * non-empty and not commented.
              */
             pips_assert("The block is non empty", !ENDP(instruction_block(new_i)));
             /* Sometimes, we generate blocks with only one statement in it. E.g. alternate returns 
             pips_assert("The block has at least two statements", !ENDP(CDR(instruction_block(new_i))));
             */
  
             fs = STATEMENT(CAR(instruction_block(new_i)));
             /* For keeping pragma attached to a loop attached to it,
                we have to find the loop instruction within the
                block */
             if(!ENDP(CDR(instruction_block(new_i)))) {
               ss = STATEMENT(CAR(CDR(instruction_block(new_i))));
  
               if(continue_statement_p(fs) && statement_loop_p(ss))
                 cs = ss;
               else
                 cs = fs;
             }
             else {
                 cs = fs;
             }
             /*
             pips_assert("The first statement has no comments",
                         statement_comments(cs) == empty_comments);
                         */
             if(statement_comments(cs) != empty_comments) {
                 user_log("Current comment of chosen statement: \"%s\"\n",
                          statement_comments(cs));
                 user_log("Block comment to be carried by first statement: \"%s\"\n",
                          PrevComm);
                 pips_internal_error("The first statement of the block should have no comments");
             }
  
             pips_assert("The chosen statement is not a block",
                         !instruction_block_p(statement_instruction(cs)));
  
             statement_comments(cs) = strdup(PrevComm);
         }
         else {
             statement_comments(s) = strdup(PrevComm);
         }
         PrevComm[0] = '\0';
         iPrevComm = 0;
     }
  
     pc = CONS(STATEMENT, s, NULL);
  
     if (BlockStack[CurrentBlock-1].c == NULL) {
         instruction_block(BlockStack[CurrentBlock-1].i) = pc;
     }
     else {
         CDR(BlockStack[CurrentBlock-1].c) = pc;
     }
     BlockStack[CurrentBlock-1].c = pc;
  
     /* while i is the last instruction of the current block ... */
     while (BlockStack[CurrentBlock-1].l != NULL &&
            strcmp(label_local_name(l), BlockStack[CurrentBlock-1].l) == 0)
                 PopBlock();
  
     pips_debug(8, "End for instruction %s with label \"%s\"\n",
                instruction_identification(i), label_local_name(l));
 }               

References BlockStack, CAR, CDR, CONS, continue_statement_p(), CurrentBlock, empty_comments, ENDP, entity_empty_label_p(), instruction_block, instruction_block_p, instruction_identification(), iPrevComm, IsBlockStackEmpty(), lab_I, label_local_name(), MakeLabel(), MakeStatement(), ParserError(), pips_assert, pips_debug, pips_internal_error, PopBlock(), PrevComm, reset_current_label_string(), STATEMENT, statement_comments, statement_instruction, statement_loop_p(), statement_undefined, strdup(), and user_log().

Referenced by EndOfProcedure(), GenerateReturn(), MakeBlockIfInst(), MakeDoInst(), MakeElseInst(), MakeEnddoInst(), MakeEndifInst(), and MakeWhileDoInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ LocalToGlobal()

entity LocalToGlobal ( entity e )

Definition at line 1801 of file procedure.c.

 {
     return SafeLocalToGlobal(e, type_undefined);
 }

References SafeLocalToGlobal(), and type_undefined.

Referenced by MakeEntry(), and MakeExternalFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ loop_to_implieddo()

expression loop_to_implieddo ( loop l )

Fix last parameter

Definition at line 167 of file expression.c.

                                        {
   syntax index = make_syntax_reference( make_reference( loop_index(l), NIL ) );
   range r = loop_range(l);
  
  
   /* Fix last parameter */
   statement body = loop_body(l);
   instruction ibody = statement_instruction(body);
   list args = NIL;
   if(instruction_sequence_p(ibody)) {
     sequence seq = instruction_sequence(ibody);
     FOREACH(statement,stmt,sequence_statements(seq)) {
       args = make_arg_from_stmt(stmt, args);
     }
     args = gen_nreverse(args);
   } else {
     args = make_arg_from_stmt(body, args);
   }
   return MakeImpliedDo(index, r, args);
 }

References FOREACH, gen_nreverse(), instruction_sequence, instruction_sequence_p, loop_body, loop_index, loop_range, make_arg_from_stmt(), make_reference(), make_syntax_reference(), MakeImpliedDo(), NIL, sequence_statements, and statement_instruction.

Referenced by gfc2pips_code2instruction_(), and make_arg_from_stmt().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ make_check_io_statement()

statement make_check_io_statement	(	string	n,
		expression	u,
		entity	l
	)

Generate a test to jump to l if flag f is TRUE Used to implement control effects of IO's due to ERR= and END=.

Should not use MakeStatement() directly or indirectly to avoid counting these pseudo-instructions

Definition at line 1691 of file statement.c.

 {
     entity a = FindEntity(IO_EFFECTS_PACKAGE_NAME, n);
     reference r = make_reference(a, CONS(EXPRESSION, u, NIL));
     expression c = reference_to_expression(r);
     statement b = instruction_to_statement(make_goto_instruction(l));
     instruction t = make_instruction(is_instruction_test,
                                      make_test(c, b, make_empty_block_statement()));
     statement check = instruction_to_statement(t);
  
     statement_consistent_p(check);
  
     return check;
 }

References CONS, EXPRESSION, FindEntity(), instruction_to_statement(), IO_EFFECTS_PACKAGE_NAME, is_instruction_test, make_empty_block_statement(), make_goto_instruction(), make_instruction(), make_reference(), make_test(), NIL, reference_to_expression(), and statement_consistent_p().

Referenced by MakeIoInstA().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ make_Fortran_constant_entity()

entity make_Fortran_constant_entity	(	string	name,
		tag	bt,
		size_t	size
	)

Parameters

name	ame
bt	t
size	ize

Definition at line 597 of file expression.c.

 {
   return make_C_or_Fortran_constant_entity(name, bt, size, true, ParserError);
 }

References make_C_or_Fortran_constant_entity(), and ParserError().

Here is the call graph for this function:

◆ make_goto_instruction()

instruction make_goto_instruction ( entity l )

In a "go to" instruction, the label does not appear explictly.

It is replaced by the statement to be jumped at. If the statement carrying the label has been encountered before, everything is fine. Else the target statement has to be synthesized blindly ahead of time.

Definition at line 706 of file statement.c.

 {
   statement s = LabelToStmt(entity_name(l));
   instruction g = instruction_undefined;
  
   if (s == statement_undefined) {
     s = make_statement(l,
                        STATEMENT_NUMBER_UNDEFINED,
                        STATEMENT_ORDERING_UNDEFINED,
                        empty_comments,
                        instruction_undefined, NIL, NULL,
                        empty_extensions (), make_synchronization_none());
     NewStmt(l, s);
   }
  
   g = make_instruction(is_instruction_goto, s);
  
   return g;
 }

References empty_comments, empty_extensions(), entity_name, instruction_undefined, is_instruction_goto, LabelToStmt(), make_instruction(), make_statement(), make_synchronization_none(), NewStmt(), NIL, STATEMENT_NUMBER_UNDEFINED, STATEMENT_ORDERING_UNDEFINED, and statement_undefined.

Referenced by make_check_io_statement(), and MakeGotoInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeArithmIfInst()

instruction MakeArithmIfInst	(	expression	e,
		string	l1,
		string	l2,
		string	l3
	)

this function transforms an arithmetic if statement into a set of regular tests.

long but easy to understand without comments.

e is the test expression. e is inserted in the instruction returned (beware of sharing)

l1, l2, l3 are the three labels of the original if statement.

  IF (E) 10, 20, 30

becomes

  IF (E .LT. 0) THEN
     GOTO 10
  ELSE
     IF (E .EQ. 0) THEN
        GOTO 20
     ELSE
        GOTO 30
     ENDIF
  ENDIF

FI: Should be improved by testing equality between l1, l2 and l3 Cases observed: l1 == l2 l2 == l3 l1 == l3 Plus, just in case, l1==l2==l3

This must be quite unusual, but the variables in e have to be dereferenced to respect the use-def chains, e may have side effects,...

If the optimizer is very good, the absolute value of e should be checked positive?

General case

Parameters

l1	1
l2	2
l3	3

Definition at line 1399 of file statement.c.

 {
     expression e1, e2;
     statement s1, s2, s3, s;
     instruction ifarith = instruction_undefined;
  
     /* FI: Should be improved by testing equality between l1, l2 and l3
      * Cases observed:
      *  l1 == l2
      *  l2 == l3
      *  l1 == l3
      * Plus, just in case, l1==l2==l3
      */
  
     if(strcmp(l1,l2)==0) {
         if(strcmp(l2,l3)==0) {
             /* This must be quite unusual, but the variables in e have to be dereferenced
              * to respect the use-def chains, e may have side effects,...
              *
              * If the optimizer is very good, the absolute value of e 
              * should be checked positive?
              */
             e1 = MakeUnaryCall(CreateIntrinsic("ABS"), e);
             e2 = MakeBinaryCall(CreateIntrinsic(".GE."), 
                                 e1, int_to_expression(0));
  
             s1 = instruction_to_statement(MakeGotoInst(l1));
             s2 = make_empty_block_statement();
  
             ifarith = make_instruction(is_instruction_test, 
                                        make_test(e2,s1,s2));
         }
         else {
             e1 = MakeBinaryCall(CreateIntrinsic(".LE."), 
                                 e, int_to_expression(0));
  
             s1 = instruction_to_statement(MakeGotoInst(l1));
             s3 = instruction_to_statement(MakeGotoInst(l3));
  
             ifarith = make_instruction(is_instruction_test, 
                                        make_test(e1,s1,s3));
         }
     }
     else if(strcmp(l1,l3)==0) {
         e1 = MakeBinaryCall(CreateIntrinsic(".EQ."), 
                             e, int_to_expression(0));
  
         s1 = instruction_to_statement(MakeGotoInst(l1));
         s2 = instruction_to_statement(MakeGotoInst(l2));
  
         ifarith = make_instruction(is_instruction_test, 
                                                       make_test(e1,s2,s1));
     }
     else if(strcmp(l2,l3)==0) {
         e1 = MakeBinaryCall(CreateIntrinsic(".LT."), 
                             e, int_to_expression(0));
  
         s1 = instruction_to_statement(MakeGotoInst(l1));
         s2 = instruction_to_statement(MakeGotoInst(l2));
  
         ifarith = make_instruction(is_instruction_test, 
                                    make_test(e1,s1,s2));
     }
     else {
         /* General case */
         e1 = MakeBinaryCall(CreateIntrinsic(".LT."), 
                             e, int_to_expression(0));
         e2 = MakeBinaryCall(CreateIntrinsic(".EQ."), 
                             copy_expression(e), int_to_expression(0));
  
         s1 = instruction_to_statement(MakeGotoInst(l1));
         s2 = instruction_to_statement(MakeGotoInst(l2));
         s3 = instruction_to_statement(MakeGotoInst(l3));
  
         s = instruction_to_statement(make_instruction(is_instruction_test, 
                                                       make_test(e2,s2,s3)));
         statement_number(s) = get_statement_number();
  
         ifarith = make_instruction(is_instruction_test, make_test(e1,s1,s));
     }
  
     return ifarith;
 }

References copy_expression(), CreateIntrinsic(), get_statement_number(), instruction_to_statement(), instruction_undefined, int_to_expression(), is_instruction_test, make_empty_block_statement(), make_instruction(), make_test(), MakeBinaryCall(), MakeGotoInst(), MakeUnaryCall(), s1, and statement_number.

Here is the call graph for this function:

◆ MakeAssignedGotoInst()

instruction MakeAssignedGotoInst	(	list	ll,
		entity	i
	)

Parameters

ll l

Definition at line 734 of file statement.c.

 {
     instruction inst;
     expression expr = entity_to_expression(i);
  
     DeclareVariable(i, type_undefined, NIL, storage_undefined, value_undefined);
  
     inst = MakeAssignedOrComputedGotoInst(ll, expr, true);
  
     return inst;
 }

References DeclareVariable(), entity_to_expression(), MakeAssignedOrComputedGotoInst(), NIL, storage_undefined, type_undefined, and value_undefined.

Here is the call graph for this function:

◆ MakeAssignedOrComputedGotoInst()

instruction MakeAssignedOrComputedGotoInst	(	list	ll,
		expression	ce,
		bool	assigned
	)

ce might have side effects

ce can be used several times without side effects

We cannot know yet if ce has side effects

expression_intrinsic_operation_p(ce): a user call may be hidden at a lower level and some intrinsics may have side effects and it might be more efficient not to recompute a complex expression several times

Prefix starts with I to avoid an explicit declaration and a regeneration of declarations by the prettyprinter.

Assigned GO TO: if the current label is not in the list, this is an error in Fortran 90. ISO/IEC 1539 Section 8.2.4 page 108. Same in Fortran 77 standard, Section 11-2.

Update the statement numbers of all possibly allocated statements

MakeStatement won't increment the current statement number because this is a block... so it has to be done here

FatalError("parser", "computed goto statement prohibited\n");

Parameters

ll	l
ce	e
assigned	ssigned

Definition at line 747 of file statement.c.

 {
   instruction ins = instruction_undefined;
   list cs = NIL;
   int l = 0;
   list cl = list_undefined;
   expression e = expression_undefined;
   syntax sce = expression_syntax(ce);
   statement s_init = statement_undefined;
  
   /* ce might have side effects */
   if(syntax_reference_p(sce)) {
     /* ce can be used several times without side effects */
     e = ce;
   }
   else if(syntax_call_p(sce)) {
     if(call_constant_p(syntax_call(sce))) {
       e = ce;
     }
     else {
       /* We cannot know yet if ce has side effects */
       /* expression_intrinsic_operation_p(ce): a user call may be hidden
          at a lower level and some intrinsics may have side effects and
          it might be more efficient not to recompute a complex
          expression several times */
       /* Prefix starts with I to avoid an explicit declaration and a
          regeneration of declarations by the prettyprinter. */
       entity tmp = make_new_scalar_variable_with_prefix("ICG",
                                                         get_current_module_entity(),
                                                         make_basic(is_basic_int, (void*) 4));
       s_init = make_assign_statement(entity_to_expression(tmp), ce);
  
       e = entity_to_expression(tmp);
     }
   }
   else {
     pips_internal_error("No range expected", false);
   }
     
  
   for(l = gen_length(ll), cl = ll; !ENDP(cl); l--, POP(cl)) {
     string ln = STRING(CAR(cl));
     instruction g = MakeGotoInst(ln);
     expression cond = 
       MakeBinaryCall(
                      gen_find_tabulated(
                                         make_entity_fullname(TOP_LEVEL_MODULE_NAME,
                                                              EQUAL_OPERATOR_NAME), 
                                         entity_domain),
                      copy_expression(e),
                      int_to_expression(assigned? atoi(ln):l));
     /* Assigned GO TO: if the current label is not in the list, this is an error
      * in Fortran 90. ISO/IEC 1539 Section 8.2.4 page 108. Same in Fortran 77
      * standard, Section 11-2.
      */
     statement may_stop = (assigned && (cl==ll)) ?
       instruction_to_statement(MakeZeroOrOneArgCallInst(STOP_FUNCTION_NAME,
                                                         expression_undefined))
       :
       make_empty_statement();
     instruction iif = 
       make_instruction(is_instruction_test,
                        make_test(cond,
                                  instruction_to_statement(g),
                                  may_stop));
     statement s = statement_undefined;
  
     s = instruction_to_statement(iif);
  
     /* Update the statement numbers of all possibly allocated statements */
     statement_number(s) = get_statement_number();
     if(stop_statement_p(may_stop))
       statement_number(may_stop) = get_statement_number();
  
     cs = CONS(STATEMENT, s, cs);
   }
  
   if(!statement_undefined_p(s_init))
     cs = CONS(STATEMENT, s_init, cs);
  
   /* MakeStatement won't increment the current statement number
    * because this is a block... so it has to be done here
    */
   //  (void) get_next_statement_number();
   ins = make_instruction_block(cs);
  
   (void) instruction_consistent_p(ins);
  
   /* FatalError("parser", "computed goto statement prohibited\n"); */
  
   return ins;
 }

References call_constant_p, CAR, CONS, copy_expression(), ENDP, entity_domain, entity_to_expression(), EQUAL_OPERATOR_NAME, expression_syntax, expression_undefined, gen_find_tabulated(), gen_length(), get_current_module_entity(), get_statement_number(), instruction_consistent_p(), instruction_to_statement(), instruction_undefined, int_to_expression(), is_basic_int, is_instruction_test, list_undefined, make_assign_statement(), make_basic(), make_empty_statement, make_entity_fullname(), make_instruction(), make_instruction_block(), make_new_scalar_variable_with_prefix(), make_test(), MakeBinaryCall(), MakeGotoInst(), MakeZeroOrOneArgCallInst(), NIL, pips_internal_error, POP, s_init, STATEMENT, statement_number, statement_undefined, statement_undefined_p, STOP_FUNCTION_NAME, stop_statement_p(), STRING, syntax_call, syntax_call_p, syntax_reference_p, and TOP_LEVEL_MODULE_NAME.

Referenced by MakeAssignedGotoInst(), and MakeComputedGotoInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeAssignInst()

instruction MakeAssignInst	(	syntax	l,
		expression	e
	)

this function creates an affectation statement.

l is a reference (the left hand side).

e is an expression (the right hand side).

Let us keep the statement function definition somewhere.

Preserve the current comments as well as the information about the macro substitution

FI: we stumble here when a Fortran macro is used.

FI: we stumble here when a Fortran PARAMETER is used as lhs.

Definition at line 848 of file statement.c.

 {
    expression lhs = expression_undefined;
    instruction i = instruction_undefined;
  
    if(syntax_reference_p(l)) {
      lhs = make_expression(l, normalized_undefined);
      i = make_assign_instruction(lhs, e);
    }
    else
    {
        if(syntax_call_p(l) &&
           strcmp(entity_local_name(call_function(syntax_call(l))), 
                  SUBSTRING_FUNCTION_NAME) == 0) 
        {
            list lexpr = CONS(EXPRESSION, e, NIL);
            list asub = call_arguments(syntax_call(l));
            
            call_arguments(syntax_call(l)) = NIL;
            free_syntax(l);
            
            i = make_instruction(is_instruction_call,
               make_call(entity_intrinsic(ASSIGN_SUBSTRING_FUNCTION_NAME),
                         gen_append(asub, lexpr)));
        }
        else
        {
            if (syntax_call_p(l) && 
              !value_symbolic_p(entity_initial(call_function(syntax_call(l)))))
            {
                if (get_bool_property("PARSER_EXPAND_STATEMENT_FUNCTIONS"))
                {
                    /* Let us keep the statement function definition somewhere.
                     */
                    /* Preserve the current comments as well as the information
                       about the macro substitution */
                    statement stmt1 = make_continue_statement(entity_empty_label());
                    statement stmt2 = make_continue_statement(entity_empty_label());
  
                    pips_debug(5, "considering %s as a macro\n", 
                               entity_name(call_function(syntax_call(l))));
  
                    parser_add_a_macro(syntax_call(l), e);
                    statement_comments(stmt2) =
                        strdup(concatenate("C$PIPS STATEMENT FUNCTION ",
                                           entity_local_name(call_function(syntax_call(l))),
                                           " SUBSTITUTED\n", 0));
                    i = make_instruction_block(CONS(STATEMENT, stmt1,
                                                    CONS(STATEMENT, stmt2, NIL)));
                }
                else
                {
                    /* FI: we stumble here when a Fortran macro is used. */
                    user_warning("MakeAssignInst", "%s() appears as lhs\n",
                        entity_local_name(call_function(syntax_call(l))));
                    ParserError("MakeAssignInst",
                                "bad lhs (function call or undeclared array)"
                                " or PIPS unsupported Fortran macro\n"
                                "you might consider switching the "
                                "PARSER_EXPAND_STATEMENT_FUNCTIONS property,\n"
                                "in the latter, at your own risk...\n");
                }
            }
            else {
                if(syntax_call_p(l)) {
                    /* FI: we stumble here when a Fortran PARAMETER is used as lhs. */
                    user_warning("MakeAssignInst", "PARAMETER %s appears as lhs\n",
                        entity_local_name(call_function(syntax_call(l))));
                    ParserError("MakeAssignInst",
                                "Illegal lhs\n");
                }
                else {
                    FatalError("MakeAssignInst", "Unexpected syntax tag\n");
                }
            }
        }
    }
  
    return i;
 }

References ASSIGN_SUBSTRING_FUNCTION_NAME, call_arguments, call_function, concatenate(), CONS, entity_empty_label(), entity_initial, entity_intrinsic(), entity_local_name(), entity_name, EXPRESSION, expression_undefined, FatalError, free_syntax(), gen_append(), get_bool_property(), instruction_undefined, is_instruction_call, make_assign_instruction(), make_call(), make_continue_statement(), make_expression(), make_instruction(), make_instruction_block(), NIL, normalized_undefined, parser_add_a_macro(), ParserError(), pips_debug, STATEMENT, statement_comments, strdup(), SUBSTRING_FUNCTION_NAME, syntax_call, syntax_call_p, syntax_reference_p, user_warning, and value_symbolic_p.

Here is the call graph for this function:

◆ MakeAtom()

syntax MakeAtom	(	entity	e,
		cons *	indices,
		expression	fc,
		expression	lc,
		int	HasParenthesis
	)

MakeAtom: this function creates a syntax, ie.

a reference, a call or a range.

there are a few good cases: e is a variable and its dimensionality is equal to the number of expressions in indices, e is a function, e is a constant or a symbolic constant.

there are a few bad cases: e is a zero dimension variable and indices is not equal to NIL (see comments of MakeExternalFunction), e is not known and the list indices is not empty (it is a call to a user function), e is not known and the list indices is empty (it is an implicit declaration).

in this function, we first try to transform bad cases into good ones, and then to create a syntax.

e is a variable or a function.

indices is a list of expressions (arguments or indices).

fc and lc are substring bound expressions.

HasParenthesis is a bool that tells if the reference to e was done with () or not. this is mandatory to make the difference between a call to a function and a reference to a function.

MakeAtom in expression.c fixed to generate the proper message when the substring operator is used (Francois Irigoin, 6 June 1995). See lcart2.f in Validation.

checking errors ...

It can be a PARAMETER or a functional variable or...

Not enough information to decide to stop or not.

ParserError("MakeAtom", "unsupported use of a functional entity\n");

fixing bad cases

FI: to handle parameterless function calls like t= second() - 11 March 1993

if (indices == NULL) {

It has already been declared and should not be redeclared because it may be an entry formal parameter which is not declared in the current module. If e represents an entry formal parameter (although its top-level name is the current module), it does not belong to the declarations of the current module. Hence, it is hard to assert something here.

However, e has to be typed and valued.

e = MakeExternalFunction(e, type_undefined);

use expression list to compute argument types

FI: same as in previous paragraph

if (variable_dimensions(type_variable(te))==NULL && indices!=NULL) {

if (variable_dimensions(type_variable(te))==NULL && (indices!=NULL || HasParenthesis)) {

use expression list to compute argument types

FI: probleme here for character returning function! You have to know if you are dealing with a substring operator or a function call.

Fortunately, according to SUN f77 compiler, you are not allowed to take the substring of a function call!

In fact, only check compatability... if requested!

here, bad cases have been transformed into good ones.

substring

pips_assert("Substring can only be applied to a string", basic_string_p(bt));

Probably an extension we would have liked to have for the DREAM-UP project.

The upper bound may be unknown for formal parameters and for allocatable arrays and cannot be retrieved from the type declaration

ParserError("MakeAtom", "Substrings are not implemented\n");

e is either called or passed as argument to a function. It cannot be a PARAMETER or its value would be known.

e is either called or passed as argument to a function, or it is a PARAMETER, in which case, it must really be called.

Parameters

indices	ndices
fc	c
lc	c
HasParenthesis	asParenthesis

Definition at line 222 of file expression.c.

 {
     syntax s = syntax_undefined;
     type te;
  
     te = entity_type(e);
  
     /* checking errors ... */
     if (te != type_undefined) {
         if (type_statement_p(te)) {
             FatalError("MakeAtom", "label dans une expression\n");
         }
         else if (type_area_p(te)) {
             FatalError("MakeAtom", "area dans une expression\n");
         }
         else if (type_void_p(te)) {
             FatalError("MakeAtom", "void dans une expression\n");
         }
         else if (type_unknown_p(te)) {
             FatalError("MakeAtom", "unknown dans une expression\n");
         }
         else if (type_functional_p(te)) {
             if(!HasParenthesis) {
                 /* It can be a PARAMETER or a functional variable or... */
                 value iv = entity_initial(e);
                 if(!value_undefined_p(iv) && value_code_p(iv)) {
                     user_warning("MakeAtom", "reference to functional entity %s\n",
                                  entity_name(e));
                     /* Not enough information to decide to stop or not. */
                     /* ParserError("MakeAtom",
                        "unsupported use of a functional entity\n"); */
                 }
             }
         }
     }
  
     /* fixing bad cases */
     if (te == type_undefined) {
         /* FI: to handle parameterless function calls like t= second() - 11 March 1993 */
         /* if (indices == NULL) { */
         if (indices == NULL && !HasParenthesis) {
             if(storage_undefined_p(entity_storage(e))) {
                 debug(2, "MakeAtom", "implicit declaration of scalar variable: %s\n",
                   entity_name(e));
                 DeclareVariable(e, type_undefined, indices, 
                                 storage_undefined, value_undefined);
             }
             else if(storage_formal_p(entity_storage(e))) {
                 pips_debug(2, "reference to a functional parameter: %s\n",
                       entity_name(e));
                 /* It has already been declared and should not be
                    redeclared because it may be an entry formal parameter
                    which is not declared in the current module. If e
                    represents an entry formal parameter (although its
                    top-level name is the current module), it does not
                    belong to the declarations of the current
                    module. Hence, it is hard to assert something here.
  
                    However, e has to be typed and valued. */
                 if(type_undefined_p(entity_type(e))) {
                     entity_type(e) = ImplicitType(e);
                 }
                 if (value_undefined_p(entity_initial(e))) {
                     entity_initial(e) = make_value_unknown();
                 }
             }
             else {
                 debug(2, "MakeAtom", "implicit type declaration of scalar variable: %s\n",
                       entity_name(e));
                 DeclareVariable(e, type_undefined, indices, 
                                 storage_undefined, value_undefined);
             }
         }
         else {
             type tr = ImplicitType(e);
  
             debug(2, "MakeAtom", "new user function: %s\n",
                   entity_name(e));
             /* e = MakeExternalFunction(e, type_undefined); */
             e = MakeExternalFunction(e, tr);
  
             /* use expression list to compute argument types */
             update_functional_type_with_actual_arguments(e, indices);
         }
     }
     else if (type_variable_p(te)) {
         /* FI: same as in previous paragraph */
         /* if (variable_dimensions(type_variable(te))==NULL && indices!=NULL) { */
         /* if (variable_dimensions(type_variable(te))==NULL
            && (indices!=NULL || HasParenthesis)) { */
         if (variable_dimensions(type_variable(te))==NULL
             && (indices!=NULL || HasParenthesis)) {
             if(fc==expression_undefined && lc==expression_undefined)
                 /*
                   if( !basic_string_p(variable_basic(type_variable(te)))
                   || (fc==expression_undefined && lc==expression_undefined)) */ {
                 e = MakeExternalFunction(e, type_undefined);
  
                 /* use expression list to compute argument types */
                 update_functional_type_with_actual_arguments(e, indices);
  
                 /* FI: probleme here for character returning function! You have to know if
                  * you are dealing with a substring operator or a function call.
                  *
                  * Fortunately, according to SUN f77 compiler, you are not allowed to
                  * take the substring of a function call!
                  */
             }
         }
     }
     else if (type_functional_p(te) && HasParenthesis) {
       /* In fact, only check compatability... if requested! */
       update_functional_type_with_actual_arguments(e, indices);
     }
  
     /* here, bad cases have been transformed into good ones. */
     te = entity_type(e);
  
     if (type_variable_p(te)) {
         if((gen_length(indices)==0) ||
            (gen_length(indices)==
             gen_length(variable_dimensions(type_variable(te))))) {
             if (lc == expression_undefined && fc == expression_undefined) {
                 s = make_syntax(is_syntax_reference, 
                                 make_reference(e, indices));
             }
             else {
                 /* substring */
                 expression ref = 
                     make_expression(make_syntax(is_syntax_reference, 
                                                 make_reference(e, indices)),
                                     normalized_undefined);
                 expression lce = expression_undefined;
                 expression fce = expression_undefined;
                 list lexpr = NIL;
                 entity substr = entity_intrinsic(SUBSTRING_FUNCTION_NAME);
                 basic bt = variable_basic(type_variable(te));
  
                 if(!basic_string_p(bt)) {
                   /* pips_assert("Substring can only be applied to a string",
                                  basic_string_p(bt)); */
                   if(!get_bool_property("PARSER_ACCEPT_ARRAY_RANGE_EXTENSION"))
                     ParserError("MakeAtom",
                                 "Substring operations can only be applied to "
                                 "strings in Fortran 77\n");
                   else {
                     /* Probably an extension we would have liked to have
                        for the DREAM-UP project. */
                     pips_internal_error("Not implemented yet");
                   }
                 }
  
                 if(fc == expression_undefined) 
                     fce = int_to_expression(1);
                 else
                     fce = fc;
  
                 if(lc == expression_undefined) {
                     /* The upper bound may be unknown for formal
                        parameters and for allocatable arrays and cannot be
                        retrieved from the type declaration */
                     value ub = basic_string(bt);
  
                     if(value_unknown_p(ub)) {
                         lce = MakeNullaryCall(CreateIntrinsic(UNBOUNDED_DIMENSION_NAME));
                     }
                     else {
                         lce = int_to_expression(basic_type_size(bt));
                     }
                 }
                 else
                     lce = lc;
  
                 lexpr = CONS(EXPRESSION, ref, 
                              CONS(EXPRESSION, fce,
                                   CONS(EXPRESSION, lce, NIL)));
                 s = make_syntax(is_syntax_call, make_call(substr, lexpr));
                 /* ParserError("MakeAtom", "Substrings are not implemented\n"); */
             }
         }
         else {
             user_warning("MakeAtom",
                          "Too many or too few subscript expressions"
                          " for reference to %s\n",
                          entity_local_name(e));
             ParserError("MakeAtom", "Illegal array reference\n");
         }
  
     }
     else if (type_functional_p(te)) {
         if (value_unknown_p(entity_initial(e))) {
             /* e is either called or passed as argument to a function.
              It cannot be a PARAMETER or its value would be known. */
             if (indices == NIL && HasParenthesis == false) {
                 s = make_syntax(is_syntax_reference, make_reference(e, NIL));
             }
             else {
                 update_called_modules(e);
                 s = make_syntax(is_syntax_call, make_call(e, indices));
             }
         }
         else {
             if (value_code_p(entity_initial(e))) {
                 update_called_modules(e);
             }
  
             /* e is either called or passed as argument to a function, or
                it is a PARAMETER, in which case, it must really be
                called. */
             if (indices == NIL && !HasParenthesis
                 && !value_symbolic_p(entity_initial(e))) {
                 s = make_syntax(is_syntax_reference, make_reference(e, NIL));
             }
             else {
                 s = make_syntax(is_syntax_call, make_call(e, indices));
             }
         }
     }
     else {
         ParserError("MakeAtom", "unexpected type\n");
     }
         
     return(s);
 }

References basic_string, basic_string_p, basic_type_size(), CONS, CreateIntrinsic(), debug(), DeclareVariable(), entity_initial, entity_intrinsic(), entity_local_name(), entity_name, entity_storage, entity_type, EXPRESSION, expression_undefined, FatalError, gen_length(), get_bool_property(), ImplicitType(), indices, int_to_expression(), is_syntax_call, is_syntax_reference, make_call(), make_expression(), make_reference(), make_syntax(), make_value_unknown(), MakeExternalFunction(), MakeNullaryCall(), NIL, normalized_undefined, ParserError(), pips_debug, pips_internal_error, ref, storage_formal_p, storage_undefined, storage_undefined_p, SUBSTRING_FUNCTION_NAME, syntax_undefined, type_area_p, type_functional_p, type_statement_p, type_undefined, type_undefined_p, type_unknown_p, type_variable, type_variable_p, type_void_p, UNBOUNDED_DIMENSION_NAME, update_called_modules(), update_functional_type_with_actual_arguments(), user_warning, value_code_p, value_symbolic_p, value_undefined, value_undefined_p, value_unknown_p, variable_basic, and variable_dimensions.

Here is the call graph for this function:

◆ MakeBlockIfInst()

void MakeBlockIfInst	(	expression	e,
		int	elsif
	)

this function and the two next ones create a block if statement.

the true and the else part of the test are two empty blocks. e is the test expression.

the true block is pushed on the stack. it will contain the next statements, and will end with a else statement or an endif statement.

if a else statement is reached, the true block is popped and the false block is pushed to gather the false part statements. if no else statement is found, the true block will be popped with the endif statement and the false block will remain empty.

Parameters

elsif lsif

Definition at line 1498 of file statement.c.

 {  
     instruction bt, bf, i;
     expression cond = fix_if_condition(e);
  
     bt = MakeEmptyInstructionBlock();
     bf = MakeEmptyInstructionBlock();
  
     i = make_instruction(is_instruction_test,
                          make_test(cond,
                                    MakeStatement(MakeLabel(""), bt),
                                    MakeStatement(MakeLabel(""), bf)));
  
     LinkInstToCurrentBlock(i, true);
    
     PushBlock(bt, "ELSE");
     BlockStack[CurrentBlock-1].elsifs = elsif ;
 }

References BlockStack, CurrentBlock, fix_if_condition(), is_instruction_test, LinkInstToCurrentBlock(), make_instruction(), make_test(), MakeEmptyInstructionBlock(), MakeLabel(), MakeStatement(), and PushBlock().

Here is the call graph for this function:

◆ MakeCallInst()

instruction MakeCallInst	(	entity	e,
		cons *	l
	)

this function creates a call statement.

e is the called function. l is the argument list, a list of expressions.

ParserError("MakeCallInst", "Formal functional parameters are not supported " "by PIPS.\n");

FI: Before you can proceed to update_functional_type_result(), you may have to fix the type of e. Basically, if its type is not functional, it should be made functional with result void. I do not fix the problem in the parser because tons of other problems are going to appear, at least one for each PIPS analysis, starting with effects, proper, cumulated, regions, transformers, preconditions,... No quick fix, but a special effort made after an explicit decision.

The following assertion is no longer true when fucntions are passed as actual arguments.

pips_assert("e itself is returned", MakeExternalFunction(e, MakeTypeVoid()) == e);

Parameters

l	callee list of actual parameters

Definition at line 1091 of file statement.c.

 {
     instruction i = instruction_undefined;
     list ar = get_alternate_returns();
     list ap = add_actual_return_code(l);
     storage s = entity_storage(e);
     bool ffp_p = false;
     entity fe = e;
  
     if(!storage_undefined_p(s)) {
         if(storage_formal_p(s)) {
           ffp_p = true;
             pips_user_warning("entity %s is a formal functional parameter\n",
                               entity_name(e));
             /* ParserError("MakeCallInst",
                         "Formal functional parameters are not supported "
                         "by PIPS.\n"); */
             /* FI: Before you can proceed to
                update_functional_type_result(), you may have to fix
                the type of e. Basically, if its type is not
                functional, it should be made functional with result
                void. I do not fix the problem in the parser because
                tons of other problems are going to appear, at least
                one for each PIPS analysis, starting with effects,
                proper, cumulated, regions, transformers,
                preconditions,... No quick fix, but a special effort
                made after an explicit decision. */
         }
     }
  
     if(!ffp_p) {
       update_called_modules(e);
  
       /* The following assertion is no longer true when fucntions are
          passed as actual arguments. */
       /* pips_assert("e itself is returned",
          MakeExternalFunction(e, MakeTypeVoid()) == e); */
       fe = MakeExternalFunction(e, MakeTypeVoid());
     }
  
     update_functional_type_result(fe, make_type(is_type_void,UU));
     update_functional_type_with_actual_arguments(fe, ap);
  
     if(!ENDP(ar)) {
         statement s = instruction_to_statement
             (make_instruction(is_instruction_call, make_call(fe, ap)));
  
         statement_number(s) = get_statement_number();
         pips_assert("Alternate return substitution required\n", SubstituteAlternateReturnsP());
         i = generate_return_code_checks(ar);
         pips_assert("Must be a sequence", instruction_block_p(i));
         instruction_block(i) = CONS(STATEMENT,
                                     s,
                                     instruction_block(i));
     }
     else {
         i = make_instruction(is_instruction_call, make_call(fe, ap));
     }
  
     return i;
 }

References add_actual_return_code(), CONS, ENDP, entity_name, entity_storage, generate_return_code_checks(), get_alternate_returns(), get_statement_number(), instruction_block, instruction_block_p, instruction_to_statement(), instruction_undefined, is_instruction_call, is_type_void, make_call(), make_instruction(), make_type(), MakeExternalFunction(), MakeTypeVoid(), pips_assert, pips_user_warning, STATEMENT, statement_number, storage_formal_p, storage_undefined_p, SubstituteAlternateReturnsP(), update_called_modules(), update_functional_type_result(), update_functional_type_with_actual_arguments(), and UU.

Here is the call graph for this function:

◆ MakeCommon()

entity MakeCommon ( entity e )

MakeCommon: This function creates a common block.

pips creates static common blocks. This is not true in the ANSI standard stricto sensu, but true in most implementations.

A common declaration can be made out of several common statements. MakeCommon() is called for each common statement, although it only is useful the first time.

common e may already exist because it was encountered in another module but not have been registered as known by the current module. It may also already exist because it was encountered in the same module, but AddEntityToDeclarations() does not duplicate declarations.

FI: for a while, common sizes were always reset to 0, even when several common statements were encountered in the same module for the same common. This did not matter because offsets in commons are recomputed once variable types and dimensions are all known.

Definition at line 1047 of file declaration.c.

 {
     e = make_common_entity(e);
  
     /* common e may already exist because it was encountered
      * in another module
      * but not have been registered as known by the current module.
      * It may also already exist because it was encountered in
      * the *same* module, but AddEntityToDeclarations() does not
      * duplicate declarations.
      */
     AddEntityToDeclarations(e, get_current_module_entity());
  
     /* FI: for a while, common sizes were *always* reset to 0, even when
      * several common statements were encountered in the same module for
      * the same common. This did not matter because offsets in commons are
      * recomputed once variable types and dimensions are all known.
      */
     if(!common_to_defined_size_p(e))
         set_common_to_size(e, 0);
  
     return e;
 }

References AddEntityToDeclarations(), common_to_defined_size_p(), get_current_module_entity(), make_common_entity(), and set_common_to_size().

Referenced by MakeEntryCommon(), and NameToCommon().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeComputedGotoInst()

instruction MakeComputedGotoInst	(	list	ll,
		expression	e
	)

Parameters

ll l

Definition at line 727 of file statement.c.

 {
     instruction inst = MakeAssignedOrComputedGotoInst(ll, e, false);
  
     return inst;
 }

References MakeAssignedOrComputedGotoInst().

Referenced by generate_return_code_checks().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeCurrentFunction()

void MakeCurrentFunction	(	type	t,
		int	msf,
		const char *	cfn,
		list	lfp
	)

this function creates one entity cf that represents the Fortran function f being analyzed.

if f is a Fortran FUNCTION, a second entity is created; this entity represents the variable that is used in the function body to return a value. both entities share the same name and the type of the result entity is equal to the type of cf's result.

t is the type of the function result if it has been given by the programmer as in INTEGER FUNCTION F(A,B,C)

msf indicates if f is a main, a subroutine or a function.

cf is the current function

lfp is the list of formal parameters

current function

the body of the current function

the second entity, used to store the function result

to split the entity name space between mains, commons, blockdatas and regular modules

full current function name

global entity with conflicting name

Check that there is no such common: This test is obsolete because the standard does not prohibit the use of the same name for a common and a function. However, it is not a good programming practice

if(!type_undefined_p(entity_type(cf)) || ! storage_undefined_p(entity_storage(cf)) || !value_undefined_p(entity_initial(cf)))

Clean up existing local entities in case of a recompilation.

A block data may be declared in an EXTERNAL statement, see Standard 8-9

remove_variable_entity(ce);

Let's hope cf is not an intrinsic

Unfortunately, an intrinsics cannot be redefined, just like a user function or subroutine after editing because intrinsics are not handled like user functions or subroutines. They are not added to the called_modules list of other modules, unless the redefining module is parsed FIRST. There is not mechanism in PIPS to control the parsing order.

set ghost variable entities to NIL

This procedure is called when the whole module declaration statement has been parsed. The formal parameters have already been declared and the ghost variables checked. The call was moved in gram.y, reduction rule for psf_keyword.

init_ghost_variable_entities();

initialize equivalence chain lists to NIL

the intended result type t for a main or a subroutine should be undefined

The parameters part of cf's functional type is not created because the types of formal parameters are not known yet. This is performed later by UpdateFunctionalType().

If a call to the function has been encountered before, it's already typed. However, this information is discarded.

a function has a rom storage

a function has an initial value 'code' that contains an empty block

FI: This NULL string is a catastrophy for the strcmp used later to check the content of the stack. Any string, including the empty string "", would be better. icf is used to link new instructions/statement to the current block. Only the first block is not pushed for syntactic reasons. The later blocks will be pushed for DO's and IF's.

PushBlock(icf, (string) NULL);

No common has yet been declared

Generic areas are created for memory allocation.

Formal parameters are created. Alternate returns can be ignored or substituted.

a result entity is created

esult = FindOrCreateEntity(CurrentPackage, entity_local_name(cf));

CleanLocalEntities() does not remove any entity

Parameters

msf	sf
cfn	fn
lfp	fp

Definition at line 1239 of file procedure.c.

 {
     entity cf = entity_undefined; /* current function */
     instruction icf; /* the body of the current function */
     entity result; /* the second entity, used to store the function result */
     /* to split the entity name space between mains, commons, blockdatas and regular modules */
     string prefix = string_undefined;
     string fcfn = string_undefined; /* full current function name */
     entity ce = entity_undefined; /* global entity with conflicting name */
  
     /* Check that there is no such common: This test is obsolete because
      * the standard does not prohibit the use of the same name for a
      * common and a function. However, it is not a good programming practice
      */
     if (gen_find_tabulated(concatenate
            (TOP_LEVEL_MODULE_NAME, MODULE_SEP_STRING,
             COMMON_PREFIX, cfn, NULL),
                            entity_domain) != entity_undefined)
     {
         pips_user_warning("global name %s used for a module and for a common\n",
                           cfn);
         /*
         ParserError("MakeCurrentFunction",
                     "Name conflict between a "
                     "subroutine and/or a function and/or a common\n");
                     */
     }
  
     if(msf==TK_PROGRAM) {
         prefix = MAIN_PREFIX;
     }
     else if(msf==TK_BLOCKDATA) {
         prefix = BLOCKDATA_PREFIX;
     }
     else  {
         prefix = "";
     }
     fcfn = strdup(concatenate(prefix, cfn, NULL));
     cf = FindOrCreateEntity(TOP_LEVEL_MODULE_NAME, fcfn);
     free(fcfn);
  
     /* if(!type_undefined_p(entity_type(cf))
        || ! storage_undefined_p(entity_storage(cf))
        || !value_undefined_p(entity_initial(cf))) */
  
     if(!value_undefined_p(entity_initial(cf))) {
       if(value_code_p(entity_initial(cf))) {
         code c = value_code(entity_initial(cf));
         if(!code_undefined_p(c) && !ENDP(code_declarations(c))) {
           /* Clean up existing local entities in case of a recompilation. */
           CleanLocalEntities(cf);
         }
       }
     }
  
     ce = FindEntity(TOP_LEVEL_MODULE_NAME, cfn);
     if(!entity_undefined_p(ce) && ce!=cf) {
       if(!value_undefined_p(entity_initial(cf)) || msf!=TK_BLOCKDATA) {
         user_warning("MakeCurrentFunction", "Global name %s used for a function or subroutine"
                      " and for a %s\n", cfn, msf==TK_BLOCKDATA? "blockdata" : "main");
         ParserError("MakeCurrentFunction", "Name conflict\n");
       }
       else {
         /* A block data may be declared in an EXTERNAL statement, see Standard 8-9 */
         pips_debug(1, "Entity \"%s\" does not really exist."
               " A blockdata is declared in an EXTERNAL statement.",
                    entity_name(ce));
         /* remove_variable_entity(ce); */
         remove_module_entity(ce);
       }
     }
  
     /* Let's hope cf is not an intrinsic */
     if( entity_type(cf) != type_undefined
        && intrinsic_entity_p(cf) ) {
         user_warning("MakeCurrentFunction",
                      "Intrinsic %s redefined.\n"
                      "This is not supported by PIPS. Please rename %s\n",
                      entity_local_name(cf), entity_local_name(cf));
         /* Unfortunately, an intrinsics cannot be redefined, just like a user function
          * or subroutine after editing because intrinsics are not handled like
          * user functions or subroutines. They are not added to the called_modules
          * list of other modules, unless the redefining module is parsed FIRST.
          * There is not mechanism in PIPS to control the parsing order.
          */
         ParserError("MakeCurrentFunction",
                     "Name conflict between a "
                     "subroutine and/or a function and an intrinsic\n");
     }
  
     /* set ghost variable entities to NIL */
     /* This procedure is called when the whole module declaration
        statement has been parsed. The formal parameters have already been
        declared and the ghost variables checked. The call was moved in
        gram.y, reduction rule for psf_keyword. */
     /* init_ghost_variable_entities(); */
  
     /* initialize equivalence chain lists to NIL */
     SetChains();
  
     if (msf == TK_FUNCTION) {
         if (t == type_undefined) {
             t = ImplicitType(cf);
         }
     }
     else {
         if (t == type_undefined) {
             t = make_type(is_type_void, UU);
         }
         else {
             /* the intended result type t for a main or a subroutine should be undefined */
             FatalError("MakeCurrentFunction", "bad type\n");
         }
     }
  
     /* The parameters part of cf's functional type is not created because
        the types of formal parameters are not known yet. This is performed
        later by UpdateFunctionalType().
  
        If a call to the function has been encountered before, it's already
        typed. However, this information is discarded.  */
     if(!type_undefined_p(entity_type(cf))) {
         free_type(entity_type(cf));
     }
     entity_type(cf) = make_type(is_type_functional, make_functional(NIL, t));
  
     /* a function has a rom storage */
     entity_storage(cf) = make_storage_rom();
  
     /* a function has an initial value 'code' that contains an empty block */
     icf = MakeEmptyInstructionBlock();
  
     /* FI: This NULL string is a catastrophy for the strcmp used later
      * to check the content of the stack. Any string, including
      * the empty string "", would be better. icf is used to link new
      * instructions/statement to the current block. Only the first
      * block is not pushed for syntactic reasons. The later blocks
      * will be pushed for DO's and IF's.
      */
     /* PushBlock(icf, (string) NULL); */
     PushBlock(icf, "INITIAL");
  
     function_body = instruction_to_statement(icf);
     entity_initial(cf) =
       make_value(is_value_code,
                  make_code(NIL, NULL, make_sequence(NIL),NIL,
                            make_language_fortran()));
  
     set_current_module_entity(cf);
  
     /* No common has yet been declared */
     initialize_common_size_map();
  
     /* Generic areas are created for memory allocation. */
     InitAreas();
  
     /* Formal parameters are created. Alternate returns can be ignored
      * or substituted.
      */
     SubstituteAlternateReturns
         (get_string_property("PARSER_SUBSTITUTE_ALTERNATE_RETURNS"));
     ScanFormalParameters(cf, add_formal_return_code(lfp));
  
     if (msf == TK_FUNCTION) {
       /* a result entity is created */
       /*result = FindOrCreateEntity(CurrentPackage, entity_local_name(cf));*/
       /*
         result = make_entity(strdup(concatenate(CurrentPackage,
                                                 MODULE_SEP_STRING,
                                                 module_local_name(cf),
                                                 NULL)),
                              type_undefined,
                              storage_undefined,
                              value_undefined);
       */
       /* CleanLocalEntities() does not remove any entity */
       result = FindOrCreateEntity(CurrentPackage,
                                                  module_local_name(cf));
       DeclareVariable(result, t, NIL, make_storage(is_storage_return, cf),
                       value_undefined);
       AddEntityToDeclarations(result, cf);
     }
 }

References add_formal_return_code(), AddEntityToDeclarations(), BLOCKDATA_PREFIX, CleanLocalEntities(), code_declarations, code_undefined_p, COMMON_PREFIX, concatenate(), CurrentPackage, DeclareVariable(), ENDP, entity_domain, entity_initial, entity_local_name(), entity_name, entity_storage, entity_type, entity_undefined, entity_undefined_p, FatalError, FindEntity(), FindOrCreateEntity(), free(), free_type(), function_body, gen_find_tabulated(), get_string_property(), ImplicitType(), InitAreas(), initialize_common_size_map(), instruction_to_statement(), intrinsic_entity_p(), is_storage_return, is_type_functional, is_type_void, is_value_code, MAIN_PREFIX, make_code(), make_functional(), make_language_fortran(), make_sequence(), make_storage(), make_storage_rom(), make_type(), make_value(), MakeEmptyInstructionBlock(), module_local_name(), MODULE_SEP_STRING, NIL, ParserError(), pips_debug, pips_user_warning, prefix, PushBlock(), remove_module_entity(), ScanFormalParameters(), set_current_module_entity(), SetChains(), strdup(), string_undefined, SubstituteAlternateReturns(), TK_BLOCKDATA, TK_FUNCTION, TK_PROGRAM, TOP_LEVEL_MODULE_NAME, type_undefined, type_undefined_p, user_warning, UU, value_code, value_code_p, value_undefined, and value_undefined_p.

Here is the call graph for this function:

◆ MakeDataStatement()

void MakeDataStatement	(	list	ldr,
		list	ldv
	)

Receives as first input an implicit list of references, including implicit DO, and as second input an list of value using pseudo-intrinsic REPEAT_VALUE() to replicate values.

Generates a call statement to STATIC-INITIALIZATION(), with a call to DATA_LIST to prefix ldr (unlike IO list). Processes the information as AnalyzeData() used to do it. Add the new data call statement to the initializations field of the current module.

Parameters

ldr	dr
ldv	dv

Definition at line 524 of file declaration.c.

 {
   statement ds = statement_undefined;
   code mc = entity_code(get_current_module_entity());
   entity dl = FindEntity(TOP_LEVEL_MODULE_NAME, DATA_LIST_FUNCTION_NAME);
   expression pldr = expression_undefined;
  
   pips_assert("The static initialization pseudo-intrinsic is defined",
               !entity_undefined_p(dl));
  
   pldr = make_call_expression(dl, ldr);
   ds = make_call_statement(STATIC_INITIALIZATION_NAME,
                            gen_nconc(CONS(EXPRESSION, pldr, NIL), ldv),
                            entity_undefined,
                            strdup(PrevComm));
   PrevComm[0] = '\0';
   iPrevComm = 0;
  
   sequence_statements(code_initializations(mc)) = 
     gen_nconc(sequence_statements(code_initializations(mc)), CONS(STATEMENT, ds, NIL));
 }

References code_initializations, CONS, DATA_LIST_FUNCTION_NAME, entity_code(), entity_undefined, entity_undefined_p, EXPRESSION, expression_undefined, FindEntity(), gen_nconc(), get_current_module_entity(), iPrevComm, make_call_expression(), make_call_statement(), NIL, pips_assert, PrevComm, sequence_statements, STATEMENT, statement_undefined, STATIC_INITIALIZATION_NAME, strdup(), and TOP_LEVEL_MODULE_NAME.

Here is the call graph for this function:

◆ MakeDoInst()

void MakeDoInst	(	syntax	s,
		range	r,
		string	l
	)

this function creates a do loop statement.

s is a reference to the do variable.

r is the range of the do loop.

l is the label of the last statement of the loop.

This free is not nice for the caller! Nor for the debugger.

Let's build a sequence with loop range assignments

Definition at line 1167 of file statement.c.

 {
     instruction ido, instblock_do;
     statement stmt_do;
     entity dovar, dolab;
  
     if (!syntax_reference_p(s))
             FatalError("MakeDoInst", "function call as DO variable\n");
  
     if (reference_indices(syntax_reference(s)) != NULL)
             FatalError("MakeDoInst", "variable reference as DO variable\n");
  
     dovar = reference_variable(syntax_reference(s));
     reference_variable(syntax_reference(s)) = entity_undefined;
     /* This free is not nice for the caller! Nor for the debugger. */
     free_syntax(s);
  
     dolab = MakeLabel((strcmp(l, "BLOCKDO") == 0) ? "" : l);
  
     instblock_do = MakeEmptyInstructionBlock();
     stmt_do = instruction_to_statement(instblock_do);
  
     if(get_bool_property("PARSER_LINEARIZE_LOOP_BOUNDS")) {
       normalized nl = NORMALIZE_EXPRESSION(range_lower(r));
       normalized nu = NORMALIZE_EXPRESSION(range_upper(r));
       normalized ni = NORMALIZE_EXPRESSION(range_increment(r));
  
       if(normalized_linear_p(nl) && normalized_linear_p(nu) &&  normalized_linear_p(ni)) {
         ido = make_instruction(is_instruction_loop,
                                make_loop(dovar, r, stmt_do, dolab,
                                          make_execution(is_execution_sequential, 
                                                         UU),
                                          NIL));
       }
       else {
         /* Let's build a sequence with loop range assignments */
         instruction sido = make_instruction(is_instruction_loop,
                                             make_loop(dovar, r, stmt_do, dolab,
                                                       make_execution(is_execution_sequential, 
                                                                      UU),
                                                       NIL));
         list a = CONS(STATEMENT, instruction_to_statement(sido), NIL);
  
         if(!normalized_linear_p(ni)) {
           entity nv = make_new_scalar_variable_with_prefix("INC_",
                                                            get_current_module_entity(),
                                                            make_basic(is_basic_int, (void*) 4));
           instruction na = make_assign_instruction(entity_to_expression(nv),range_increment(r));
           range_increment(r) = entity_to_expression(nv);
           a = CONS(STATEMENT, instruction_to_statement(na), a);
         }
  
         if(!normalized_linear_p(nu)) {
           entity nv = make_new_scalar_variable_with_prefix("U_",
                                                            get_current_module_entity(),
                                                            make_basic(is_basic_int, (void*) 4));
           instruction na = make_assign_instruction(entity_to_expression(nv),range_upper(r));
           range_upper(r) = entity_to_expression(nv);
           a = CONS(STATEMENT, instruction_to_statement(na), a);
         }
  
         if(!normalized_linear_p(nl)) {
           entity nv = make_new_scalar_variable_with_prefix("L_",
                                                            get_current_module_entity(),
                                                            make_basic(is_basic_int, (void*) 4));
           instruction na = make_assign_instruction(entity_to_expression(nv),range_lower(r));
           range_lower(r) = entity_to_expression(nv);
           a = CONS(STATEMENT, instruction_to_statement(na), a);
         }
         ido = make_instruction_block(a);
       }
     }
     else {
       ido = make_instruction(is_instruction_loop,
                              make_loop(dovar, r, stmt_do, dolab,
                                        make_execution(is_execution_sequential, 
                                                       UU),
                                        NIL));
     }
  
     LinkInstToCurrentBlock(ido, true);
    
     PushBlock(instblock_do, l);
 }

References CONS, entity_to_expression(), entity_undefined, FatalError, free_syntax(), get_bool_property(), get_current_module_entity(), instruction_to_statement(), is_basic_int, is_execution_sequential, is_instruction_loop, LinkInstToCurrentBlock(), make_assign_instruction(), make_basic(), make_execution(), make_instruction(), make_instruction_block(), make_loop(), make_new_scalar_variable_with_prefix(), MakeEmptyInstructionBlock(), MakeLabel(), NIL, NORMALIZE_EXPRESSION, normalized_linear_p, PushBlock(), range_increment, range_lower, range_upper, reference_indices, reference_variable, STATEMENT, syntax_reference, syntax_reference_p, and UU.

Here is the call graph for this function:

◆ MakeElseInst()

int MakeElseInst ( bool is_else_p )

This function is used to handle either an ELSE or an ELSEIF construct.

No open block can be closed by this ELSE

Generate a CONTINUE to carry the comments but not the label because the ELSE is not represented in the IR and cannot carry comments. The ELSEIF is transformed into an IF which can carry comments and label but the prettyprint of structured code is nicer if the comments are carried by a CONTINUE in the previous block. Of course, this is not good for unstructured code since comments end up far from their intended target or attached to a dead CONTINUE if the previous block ends up with a GO TO.

The current label is temporarily hidden.

generate a CONTINUE to carry the label because the ELSE is not represented in the IR

Parameters

is_else_p s_else_p

Definition at line 1522 of file statement.c.

 {
     statement if_stmt;
     test if_test;
     int elsifs;
     bool has_comments_p = (iPrevComm != 0);
  
     if(CurrentBlock==0) {
         /* No open block can be closed by this ELSE */
         ParserError("MakeElseInst", "unexpected ELSE statement\n");
     }
  
     elsifs = BlockStack[CurrentBlock-1].elsifs ;
  
     if (strcmp("ELSE", BlockStack[CurrentBlock-1].l))
         ParserError("MakeElseInst", "block if statement badly nested\n");
  
     if (has_comments_p) {
         /* Generate a CONTINUE to carry the comments but not the label
            because the ELSE is not represented in the IR and cannot carry
            comments. The ELSEIF is transformed into an IF which can carry
            comments and label but the prettyprint of structured code is
            nicer if the comments are carried by a CONTINUE in the previous
            block. Of course, this is not good for unstructured code since
            comments end up far from their intended target or attached to
            a dead CONTINUE if the previous block ends up with a GO TO.
  
            The current label is temporarily hidden. */
         string ln = strdup(get_current_label_string());
         reset_current_label_string();
         LinkInstToCurrentBlock(make_continue_instruction(), false);
         set_current_label_string(ln);
         free(ln);
     }
  
     (void) PopBlock();
  
     if_stmt = STATEMENT(CAR(BlockStack[CurrentBlock-1].c));
  
     if (! instruction_test_p(statement_instruction(if_stmt)))
         FatalError("MakeElseInst", "no block if statement\n");
  
     if_test = instruction_test(statement_instruction(if_stmt));
  
     PushBlock(statement_instruction(test_false(if_test)), "ENDIF");
  
     if (is_else_p && !empty_current_label_string_p()) {
         /* generate a CONTINUE to carry the label because the ELSE is not
            represented in the IR */
         LinkInstToCurrentBlock(make_continue_instruction(), false);
     }
  
     return( BlockStack[CurrentBlock-1].elsifs = elsifs ) ;
 }

References BlockStack, CAR, CurrentBlock, empty_current_label_string_p(), FatalError, free(), get_current_label_string(), instruction_test, instruction_test_p, iPrevComm, LinkInstToCurrentBlock(), make_continue_instruction(), ParserError(), PopBlock(), PushBlock(), reset_current_label_string(), set_current_label_string(), STATEMENT, statement_instruction, strdup(), and test_false.

Referenced by MakeEndifInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeEmptyInstructionBlock()

instruction MakeEmptyInstructionBlock ( void )

this function creates an empty block

Definition at line 654 of file statement.c.

 {
     return(make_instruction_block(NIL));
 }

References make_instruction_block(), and NIL.

Referenced by MakeBlockIfInst(), MakeCurrentFunction(), MakeDoInst(), and MakeWhileDoInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeEnddoInst()

void MakeEnddoInst ( void )

inkInstToCurrentBlock(MakeZeroOrOneArgCallInst("ENDDO", expression_undefined));

Although it is not really an instruction, the ENDDO statement may carry comments and be labelled when closing a DO label structure.

An unlabelled ENDDO can only close one loop. This cannot be performed by LinkInstToCurrentBlock().

Definition at line 1611 of file statement.c.

 {
     if(CurrentBlock<=1) {
         ParserError("MakeEnddoInst", "Unexpected ENDDO statement\n");
     }
  
     if (strcmp("BLOCKDO", BlockStack[CurrentBlock-1].l)
         &&strcmp(lab_I, BlockStack[CurrentBlock-1].l))
             ParserError("MakeEnddoInst", "block do statement badly nested\n");
  
     /*LinkInstToCurrentBlock(MakeZeroOrOneArgCallInst("ENDDO", 
                                                     expression_undefined));*/
     /* Although it is not really an instruction, the ENDDO statement may 
      * carry comments and be labelled when closing a DO label structure.
      */
     LinkInstToCurrentBlock(make_continue_instruction(), false);
  
     /* An unlabelled ENDDO can only close one loop. This cannot be
      * performed by LinkInstToCurrentBlock().
      */
     if (strcmp("BLOCKDO", BlockStack[CurrentBlock-1].l)==0)
       (void) PopBlock();
 }

References BlockStack, CurrentBlock, lab_I, LinkInstToCurrentBlock(), make_continue_instruction(), ParserError(), and PopBlock().

Here is the call graph for this function:

◆ MakeEndifInst()

void MakeEndifInst ( void )

generate a CONTINUE to carry the comments

Definition at line 1578 of file statement.c.

 {
     int elsifs = -1;
  
     if(CurrentBlock==0) {
         ParserError("MakeEndifInst", "unexpected ENDIF statement\n");
     }
  
     if (iPrevComm != 0) {
         /* generate a CONTINUE to carry the comments */
         LinkInstToCurrentBlock(make_continue_instruction(), false);
     }
  
     if (BlockStack[CurrentBlock-1].l != NULL &&
         strcmp("ELSE", BlockStack[CurrentBlock-1].l) == 0) {
         elsifs = MakeElseInst(true);
         LinkInstToCurrentBlock(make_continue_instruction(), false);
     }
     if (BlockStack[CurrentBlock-1].l == NULL ||
         strcmp("ENDIF", BlockStack[CurrentBlock-1].l)) {
         ParserError("MakeEndifInst", "block if statement badly nested\n");
     }
     else {
         elsifs = BlockStack[CurrentBlock-1].elsifs ;
     }
     pips_assert( "MakeEndifInst", elsifs >= 0 ) ;
  
     do {
         (void) PopBlock();
     } while( elsifs-- != 0 ) ;
 }

References BlockStack, CurrentBlock, iPrevComm, LinkInstToCurrentBlock(), make_continue_instruction(), MakeElseInst(), ParserError(), pips_assert, and PopBlock().

Here is the call graph for this function:

◆ MakeEntry()

instruction MakeEntry	(	entity	e,
		list	lfp
	)

An ENTRY statement is substituted by a labelled continue.

The ENTRY entity is created as in MakeExternalFunction() and MakeCurrentFunction(). list of formal parameters

current module cm

The parser expects an instruction and not a statement. I use a block wrapping to avoid tampering with lab_I.

entity e = FindOrCreateEntity(cmn, en);

result type

current chunk (temporary)

list of effective formal parameters

Name conflicts could be checked here as in MakeCurrentFunction()

Keep track of the effective formal parameters of the current module cm at the first call to MakeEntry and reallocate static variables.

Check if the static area is empty and define a specific common if not.

Too early: StaticArea is not defined yet. Postpone to ProcessEntry. if(area_size(type_area(entity_type(StaticArea)))!=0) { MakeEntryCommon(cm, StaticArea); }

Compute the result type and make sure a functional entity is being used.

In case of previous declaration in the current module

Entity e must not be destroyed if fe is a function because e must carry the result.

In case of previous declaration in the current module

Entry fe may have been encountered earlier and typed from the parameter list

This depends on what has been done in LocalToGlobal and SafeLocalToGlobal

A call site for fe has been encountered in another module

Should now be the normal case...

The entry formal parameters should be removed if they are not formal parameters of the current module... but they are referenced. They cannot be preserved although useless because they may be dimensionned by expressions legal for this entry but not for the current module. They should be removed later when dead code elimination let us know which variables are used by each entry.

Temporarily, the formal parameters of entry fe are declared in cm to keep the code consistent but they are supposedly not added to cm's declarations... because FindOrCreateEntity() does not update declarations. MakeAtom() does not redeclare formal parameters.

Let's assume it works for undefined storages..

Should it really be officially declared?

Remove it from the declaration list

fp may appear in a type statement and/or an executable statement: the information is now lost.

Request some post-processing

Parameters

lfp	entry, local to retrieve potential explicit typing

Definition at line 1810 of file procedure.c.

 {
     entity cm = get_current_module_entity(); /* current module cm */
     entity l = make_new_label(cm);
     statement s = make_continue_statement(l);
     /* The parser expects an instruction and not a statement. I use
      * a block wrapping to avoid tampering with lab_I.
      */
     instruction i = make_instruction_block(CONS(STATEMENT, s, NIL));
     /* entity e = FindOrCreateEntity(cmn, en); */
     entity fe = entity_undefined;
     bool is_a_function = entity_function_p(get_current_module_entity());
     type rt = type_undefined; /* result type */
     list cc = list_undefined; /* current chunk (temporary) */
     list lefp = list_undefined; /* list of effective formal parameters */
  
     pips_debug(1, "Begin for entry %s\n", entity_name(e));
  
     /* Name conflicts could be checked here as in MakeCurrentFunction() */
  
     /* Keep track of the effective formal parameters of the current module cm
      * at the first call to MakeEntry and reallocate static variables.
      */
     if(EmptyEntryListsP()) {
         MAP(ENTITY, fp, {
             if(!storage_undefined_p(entity_storage(fp))
                && storage_formal_p(entity_storage(fp)))
                 AddEffectiveFormalParameter(fp);
         }, entity_declarations(cm));
  
         /* Check if the static area is empty and define a specific common
          * if not.
          */
         /* Too early: StaticArea is not defined yet. Postpone to ProcessEntry.
            if(area_size(type_area(entity_type(StaticArea)))!=0) {
            MakeEntryCommon(cm, StaticArea);
            }
         */
     }
  
     /* Compute the result type and make sure a functional entity is being
      * used.
      */
     if(is_a_function) {
         rt = MakeResultType(e, type_undefined);
         /* In case of previous declaration in the current module */
         /* Entity e must not be destroyed if fe is a function because e
          * must carry the result.
          */
         fe = SafeLocalToGlobal(e, rt);
     }
     else {
         rt = make_type(is_type_void, UU);
         /* In case of previous declaration in the current module */
         fe = LocalToGlobal(e);
     }
  
     lefp = TranslateEntryFormals(fe, lfp);
     UpdateFormalStorages(fe, lefp);
  
     /* Entry fe may have been encountered earlier and typed from the
        parameter list */
     if(!type_undefined_p(entity_type(fe))) {
         free_type(entity_type(fe));
         entity_type(fe) = type_undefined;
     }
     TypeFunctionalEntity(fe, rt);
     UpdateFunctionalType(fe, lefp);
  
     /* This depends on what has been done in LocalToGlobal and SafeLocalToGlobal */
     if(storage_undefined_p(entity_storage(fe))) {
         entity_storage(fe) = make_storage_rom();
     }
     else {
         pips_assert("storage must be rom", storage_rom_p(entity_storage(fe)));
     }
  
     /* This depends on what has been done in LocalToGlobal and SafeLocalToGlobal */
     if(value_undefined_p(entity_initial(fe))) {
         entity_initial(fe) = make_value(is_value_code, make_code(lefp, strdup(""), make_sequence(NIL),NIL, make_language_fortran()));
     }
     else {
         value val = entity_initial(fe);
         code c = code_undefined;
  
         if(value_unknown_p(val)) {
             /* A call site for fe has been encountered in another module */
             entity_initial(fe) = make_value(is_value_code,
                                             make_code(lefp, strdup(""), make_sequence(NIL),NIL, make_language_fortran()));
         }
         else {
             pips_assert("value is code", value_code_p(val));
             c = value_code(entity_initial(fe));
             if(code_undefined_p(c)) {
                 value_code(entity_initial(fe)) = make_code(lefp, strdup(""), make_sequence(NIL),NIL, make_language_fortran());
             }
             else if(ENDP(code_declarations(c))) {
                 /* Should now be the normal case... */
                 code_declarations(c) = lefp;
             }
             else {
                 pips_internal_error("Code should not (yet) be defined for entry fe...");
             }
         }
     }
  
     /* The entry formal parameters should be removed if they are not
      * formal parameters of the current module... but they are referenced.
      * They cannot be preserved although useless because they may be
      * dimensionned by expressions legal for this entry but not for the
      * current module. They should be removed later when dead code elimination
      * let us know which variables are used by each entry.
      *
      * Temporarily, the formal parameters of entry fe are declared in cm
      * to keep the code consistent but they are supposedly not added to
      * cm's declarations... because FindOrCreateEntity() does not update
      * declarations. MakeAtom() does not redeclare formal parameters.
      */
     for(cc = lfp; !ENDP(cc); POP(cc)) {
         entity fp = ENTITY(CAR(cc));
         storage fps = entity_storage(fp);
  
         if(storage_undefined_p(fps) || !storage_formal_p(fps)) {
             /* Let's assume it works for undefined storages.. */
             free_storage(fps);
             entity_storage(fp) = make_storage(is_storage_formal,
                                               make_formal(cm, 0));
             /* Should it really be officially declared? */
             if(!IsEffectiveFormalParameterP(fp)) {
                 /* Remove it from the declaration list */
                 /*
                   entity_declarations(cm) =
                   arguments_rm_entity(entity_declarations(cm), fp);
                 */
                 if(entity_is_argument_p(fp,entity_declarations(cm))) {
                     pips_debug(1, "Entity %s removed from declarations for %s\n",
                           entity_name(fp), module_local_name(cm));
                     gen_remove(&entity_declarations(cm), fp);
                     pips_user_warning("Variable %s seems to be used before it is declared"
                                       " as a formal parameter for entry %s. It is legal "
                                       "if it only appears in a type statement.\n",
                                       entity_local_name(fp), entity_name(e));
                     /* fp may appear in a type statement and/or an
                        executable statement: the information is now
                        lost. */
                     /*
                     ParserError("MakeEntry",
                                 "Formal parameters of entries cannot appear textually"
                                 " in executable statements before they are declared"
                                 " (Fortran 77 Standard, 15.7.4, pp. 15-13)");
                     */
                 }
             }
         }
     }
  
     /* Request some post-processing */
     AddEntryLabel(l);
     AddEntryTarget(s);
     AddEntryEntity(fe);
  
     ifdebug(2) {
         (void) fprintf(stderr, "Declarations of formal parameters for entry %s:\n",
                        entity_name(fe));
         dump_arguments(entity_declarations(fe));
         (void) fprintf(stderr, "Declarations for current module %s:\n",
                        entity_name(cm));
         dump_arguments(entity_declarations(cm));
     }
  
     pips_debug(1, "End for entry %s\n", entity_name(fe));
  
     return i;
 }

References AddEffectiveFormalParameter(), AddEntryEntity(), AddEntryLabel(), AddEntryTarget(), CAR, code_declarations, code_undefined, code_undefined_p, CONS, dump_arguments(), EmptyEntryListsP(), ENDP, ENTITY, entity_declarations, entity_function_p(), entity_initial, entity_is_argument_p(), entity_local_name(), entity_name, entity_storage, entity_type, entity_undefined, fprintf(), free_storage(), free_type(), gen_remove(), get_current_module_entity(), ifdebug, is_storage_formal, is_type_void, is_value_code, IsEffectiveFormalParameterP(), list_undefined, LocalToGlobal(), make_code(), make_continue_statement(), make_formal(), make_instruction_block(), make_language_fortran(), make_new_label(), make_sequence(), make_storage(), make_storage_rom(), make_type(), make_value(), MakeResultType(), MAP, module_local_name(), NIL, pips_assert, pips_debug, pips_internal_error, pips_user_warning, POP, SafeLocalToGlobal(), STATEMENT, storage_formal_p, storage_rom_p, storage_undefined_p, strdup(), TranslateEntryFormals(), type_undefined, type_undefined_p, TypeFunctionalEntity(), UpdateFormalStorages(), UpdateFunctionalType(), UU, value_code, value_code_p, value_undefined_p, and value_unknown_p.

Here is the call graph for this function:

◆ MakeEquivAtom()

atom MakeEquivAtom ( syntax s )

this function creates an atom of an equivalence chain.

s is a reference to a variable.

reference offset

substring offset

Equivalenced variables cannot be initialized by a DATA statement: false

In case, the entity is not of type variable, reject it.

In case an adjustable array which is not a formal parameter has been encountered, reject it.

what is the offset of this reference ?

Definition at line 89 of file equivalence.c.

 {
     reference r = reference_undefined;
     entity e;
     int o = 0; /* reference offset */
     int so = 0; /* substring offset */
  
     if (!syntax_reference_p(s)) {
         pips_assert("This is syntax is a call", syntax_call_p(s));
         if(strcmp(entity_local_name(call_function(syntax_call(s))), 
                   SUBSTRING_FUNCTION_NAME) == 0) {
             list args = call_arguments(syntax_call(s));
             syntax ss = expression_syntax(EXPRESSION(CAR(args)));
             expression lb = EXPRESSION(CAR(CDR(args)));
  
             pips_assert("syntax is reference",syntax_reference_p(ss));
  
             r = syntax_reference(ss);
             if(expression_constant_p(lb)) {
                 so = expression_to_int(lb)-1;
             }
             else {
                 ParserError("MakeEquivAtom",
                             "Non constant substring lower bound in equivalence chain\n");
             }
         }
         else {
             pips_user_warning("A function call to %s has been identified by the parser "
                               "in an EQUIVALENCE statement. Maybe an array declaration "
                               "should be moved up ahead of the EQUIVALENCE\n",
                               module_local_name(call_function(syntax_call(s))));
             ParserError("MakeEquivAtom", "function call in equivalence chain\n");
         }
     }
     else {
         r = syntax_reference(s);
         so = 0;
     }
  
     e = reference_variable(r);
  
     if(!storage_undefined_p(entity_storage(e)) && formal_parameter_p(e)) {
       pips_user_warning("Formal parameter %s appears in EQUIVALENCE declaration\n",
                         entity_local_name(e));
             ParserError("MakeEquivAtom", "Formal parameter in equivalence chain\n");
     }
  
     /* Equivalenced variables cannot be initialized by a DATA statement: false */
     /*
     if(value_defined_p(entity_initial(e))) {
       pips_user_warning("Initialized variable %s appears in EQUIVALENCE declaration\n",
                         entity_local_name(e));
             ParserError("MakeEquivAtom", "Initialized variable in equivalence chain\n");
     }
     */
  
     /* In case, the entity is not of type variable, reject it. */
     if(!type_variable_p(entity_type(e))) {
       pips_user_warning("Illegal symbol %s appears in EQUIVALENCE declaration\n",
                         entity_local_name(e));
       ParserError("MakeEquivAtom", "Functional variable (?) in equivalence chain.\n");
     }
  
     /* In case an adjustable array which is not a formal parameter has
        been encountered, reject it. */
     if(!array_with_numerical_bounds_p(e)) {
       pips_user_warning("Adjustable array %s appears in EQUIVALENCE declaration\n",
                         entity_local_name(e));
       ParserError("MakeEquivAtom", "Adjustable array in equivalence chain\n");
     }
  
     /* what is the offset of this reference ? */
     o = so + OffsetOfReference(r);
  
     pips_debug(8, "Offset %d for reference to %s\n",
           o, entity_local_name(e));
  
     return(make_atom(e, o));
 }

References array_with_numerical_bounds_p(), call_arguments, call_function, CAR, CDR, entity_local_name(), entity_storage, entity_type, EXPRESSION, expression_constant_p(), expression_syntax, expression_to_int(), formal_parameter_p(), make_atom(), module_local_name(), OffsetOfReference(), ParserError(), pips_assert, pips_debug, pips_user_warning, reference_undefined, reference_variable, storage_undefined_p, SUBSTRING_FUNCTION_NAME, syntax_call, syntax_call_p, syntax_reference, syntax_reference_p, and type_variable_p.

Here is the call graph for this function:

◆ MakeExternalFunction()

entity MakeExternalFunction	(	entity	e,
		type	r
	)

Assertion: fe is a (functional) global entity and the type of its result is new_r, or it is a formal functional parameter

a function has a rom storage, except for formal functions

an external function has an unknown initial value, else code would be temporarily undefined which is avoided (theoretically forbidden) in PIPS.

fe is added to CurrentFunction's entities

Parameters

r	entity to be turned into external function type of result

Definition at line 2372 of file procedure.c.

 {
     entity fe = entity_undefined;
     type new_r = type_undefined;
  
     pips_debug(8, "Begin for %s\n", entity_name(e));
  
     if(entity_blockdata_p(e)) {
       pips_debug(8, "End for blockdata %s\n", entity_name(e));
       return e;
     }
  
     new_r = MakeResultType(e, r);
  
     pips_debug(9, "external function %s declared\n", entity_name(e));
  
     fe = LocalToGlobal(e);
  
     /* Assertion: fe is a (functional) global entity and the type of its
        result is new_r, or it is a formal functional parameter */
  
     TypeFunctionalEntity(fe, new_r);
  
     /* a function has a rom storage, except for formal functions */
  
     if (entity_storage(e) == storage_undefined)
         entity_storage(fe) = make_storage_rom();
     else
         if (! storage_formal_p(entity_storage(e)))
             entity_storage(fe) = make_storage_rom();
         else {
             pips_user_warning("unsupported formal function %s\n",
                          entity_name(fe));
             /*
             ParserError("MakeExternalFunction",
             "Formal functions are not supported by PIPS.\n"); */
         }
  
     /* an external function has an unknown initial value, else code would
      * be temporarily undefined which is avoided (theoretically forbidden)
      * in PIPS.  */
     if(entity_initial(fe) == value_undefined)
         entity_initial(fe) = make_value_unknown();
  
     /* fe is added to CurrentFunction's entities */
     AddEntityToDeclarations(fe, get_current_module_entity());
  
     pips_debug(8, "End for %s\n", entity_name(fe));
  
     return fe;
 }

References AddEntityToDeclarations(), entity_blockdata_p(), entity_initial, entity_name, entity_storage, entity_undefined, get_current_module_entity(), LocalToGlobal(), make_storage_rom(), make_value_unknown(), MakeResultType(), pips_debug, pips_user_warning, storage_formal_p, storage_undefined, type_undefined, TypeFunctionalEntity(), and value_undefined.

Referenced by DeclareExternalFunction(), MakeAtom(), and MakeCallInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeFormalParameter()

void MakeFormalParameter	(	entity	m,
		entity	fp,
		int	nfp
	)

This function transforms an untyped entity into a formal parameter.

fp is an entity generated by FindOrCreateEntity() for instance, and nfp is its rank in the formal parameter list.

A specific type is used for the return code variable which may be adde by the parser to handle alternate returns. See return.c offset (i.e. rank) of formal parameter

Parameters

fp	module of formal parameter
nfp	formal parameter

Definition at line 2466 of file procedure.c.

 {
   // pips_assert("type is undefined", entity_type(fp) == type_undefined);
   if(!type_undefined_p(entity_type(fp))) {
     pips_user_warning("Formal parameter \"%s\" may be used several times\n",
                       entity_local_name(fp));
     ParserError("MakeFormalParameter",
                 "formal parameter should not be already typed");
   }
  
   if(formal_label_replacement_p(fp)){
     entity_type(fp) = make_type(is_type_variable,
                                 make_variable(make_basic(is_basic_string,
                                                          make_value_unknown()),
                                               NIL,NIL));
   }
   else if(SubstituteAlternateReturnsP() && ReturnCodeVariableP(fp)) {
     entity_type(fp) = MakeTypeVariable(make_basic(is_basic_int, (void *) 4), NIL);
   }
   else {
     entity_type(fp) = ImplicitType(fp);
   }
  
   entity_storage(fp) =
     make_storage(is_storage_formal, make_formal(m, nfp));
  
   entity_initial(fp) = make_value_unknown();
 }

References entity_initial, entity_local_name(), entity_storage, entity_type, formal_label_replacement_p(), ImplicitType(), is_basic_int, is_basic_string, is_storage_formal, is_type_variable, make_basic(), make_formal(), make_storage(), make_type(), make_value_unknown(), make_variable(), MakeTypeVariable(), NIL, ParserError(), pips_user_warning, ReturnCodeVariableP(), SubstituteAlternateReturnsP(), and type_undefined_p.

Referenced by ScanFormalParameters().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeFortranBinaryCall()

expression MakeFortranBinaryCall	(	entity	op,
		expression	e1,
		expression	e2
	)

Parameters

op	p
e1	1
e2	2

Definition at line 502 of file expression.c.

 {
     expression e = expression_undefined;
  
     if(expression_implied_do_p(e1) || expression_implied_do_p(e2)) {
             ParserError("MakeFortranBinaryCall", "Unexpected implied DO\n");
     }
  
     e = MakeBinaryCall(op, e1, e2);
  
     return e;
 }

References expression_implied_do_p(), expression_undefined, MakeBinaryCall(), and ParserError().

Here is the call graph for this function:

◆ MakeFortranType()

type MakeFortranType	(	tag	t,
		value	v
	)

this function creates a type that represents a fortran type.

its basic is an int (the length of the fortran type) except in case of strings where the type might be unknown, as in:

  CHARACTER*(*) PF

t is a tag, eg: INTEGER, REAL, ...

v is a value that represents the length in bytes of the type.

Check compatibility between type and byte length

Accept INTEGER*1 for SIMD parallelizer and INTEGER*2 for legacy code and INTEGER*8 for 64 bit machines

Definition at line 1505 of file declaration.c.

 {
   basic b;
   size_t l;
  
   if (t == is_basic_string) {
     if (v == value_undefined) {
       l = DefaultLengthOfBasic(t);
       v = make_value(is_value_constant,
                      make_constant(is_constant_int, (void *) l));
     }
     b = make_basic(t, v);
   }
   else {
     bool ok = false;
     l = (v == value_undefined) ? DefaultLengthOfBasic(t) : 
       constant_int(value_constant(v));
  
     /* Check compatibility between type and byte length */
     switch (t)
       {
       case is_basic_int:
         if(get_bool_property("PARSER_ACCEPT_ANSI_EXTENSIONS"))
           /* Accept INTEGER*1 for SIMD parallelizer and INTEGER*2 for
              legacy code and INTEGER*8 for 64 bit machines */
           ok = l==1 || l==2 || l==4 || l==8;
         else
           ok = l==4;
         break;
       case is_basic_float:
         ok = l==4 || l==8;
         break;
       case is_basic_logical:
         ok = l==1 || l==2 || l==4 || l==8;
         break;
       case is_basic_complex:
         ok = l==8 || l==16;
         break;
       case is_basic_string:
         break;
       case is_basic_overloaded:
       default: break;
       }
     if(!ok) {
       ParserError("Declaration", "incompatible type length");
     }
     b = make_basic(t, (void *) l);
   }
  
   return(MakeTypeVariable(b, NIL));
 }

References constant_int, DefaultLengthOfBasic(), get_bool_property(), is_basic_complex, is_basic_float, is_basic_int, is_basic_logical, is_basic_overloaded, is_basic_string, is_constant_int, is_value_constant, make_basic(), make_constant(), make_value(), MakeTypeVariable(), NIL, ok, ParserError(), value_constant, and value_undefined.

Here is the call graph for this function:

◆ MakeFortranUnaryCall()

expression MakeFortranUnaryCall	(	entity	op,
		expression	e1
	)

Parameters

op	p
e1	1

Definition at line 519 of file expression.c.

 {
     expression e = expression_undefined;
  
     if(expression_implied_do_p(e1)) {
             ParserError("MakeFortranUnaryCall", "Unexpected implied DO\n");
     }
  
     e = MakeUnaryCall(op, e1);
  
     return e;
 }

References expression_implied_do_p(), expression_undefined, MakeUnaryCall(), and ParserError().

Referenced by gfc2pips_expr2expression(), gfc2pips_int2expression(), and gfc2pips_real2expression().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeGotoInst()

instruction MakeGotoInst ( string n )

this function creates a goto instruction.

n is the target label.

Definition at line 686 of file statement.c.

 {
     entity l = entity_undefined;
     instruction i = instruction_undefined;
  
     l = MakeLabel(n);
  
     i = make_goto_instruction(l);
  
     return i;
 }

References entity_undefined, instruction_undefined, make_goto_instruction(), and MakeLabel().

Referenced by MakeArithmIfInst(), MakeAssignedOrComputedGotoInst(), and MakeReturn().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeImpliedDo()

expression MakeImpliedDo	(	syntax	v,
		range	r,
		cons *	l
	)

expressions from input output lists might contain implied do loops.

with our internal representation, implied do loops are stored as calls to a special intrinsic function whose name is IMPLIED_DO_NAME and whose first argument is the range of the loop.

v is a reference to the do variable.

r is the range of the loop.

l is the list of expressions which are to be read or written according to this implied do loop.

the range is enclosed in an expression

Definition at line 115 of file expression.c.

 {
     call c;
     expression er;
  
     if (!syntax_reference_p(v))
       FatalError("MakeImpliedDo", "function call as DO variable\n");
  
     if (reference_indices(syntax_reference(v)) != NULL)
       FatalError("MakeImpliedDo", "variable reference as DO variable\n");
  
     /* the range is enclosed in an expression */
     er = make_expression(make_syntax(is_syntax_range, r),
        normalized_undefined);
  
     l = CONS(EXPRESSION, make_expression(v, normalized_undefined),
        CONS(EXPRESSION, er, l));
  
     c = make_call(CreateIntrinsic(IMPLIED_DO_NAME), l);
     return(make_expression(make_syntax(is_syntax_call, c),
          normalized_undefined));
 }

References CONS, CreateIntrinsic(), EXPRESSION, FatalError, IMPLIED_DO_NAME, is_syntax_call, is_syntax_range, make_call(), make_expression(), make_syntax(), normalized_undefined, reference_indices, syntax_reference, and syntax_reference_p.

Referenced by loop_to_implieddo().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeIoInstA()

instruction MakeIoInstA	(	int	keyword,
		list	lci,
		list	lio
	)

this function creates an IO statement.

keyword indicates which io statement is to be built (READ, WRITE, ...).

lci is a list of 'control specifications'. its has the following format:

    ("UNIT=", 6, "FMT=", "*", "RECL=", 80, "ERR=", 20)

lio is the list of expressions to write or references to read.

The composite IO with potential branches for ERR and END

The pure io itself

virtual tests to implement ERR= and END= clauses

we scan the list of specifications to detect labels (such as in ERR=20, END=30, FMT=50, etc.), that were stored as integer constants (20, 30, 50) and that must be replaced by labels (_20, _30, _50).

here is a label

UNIT is not defined for INQUIRE (et least) Let's use LUN 0 by default for END et ERR.

Parameters

keyword	eyword
lci	ci
lio	io

Definition at line 1715 of file statement.c.

 {
   cons *l;
   /* The composite IO with potential branches for ERR and END */
   instruction io = instruction_undefined;
   /* The pure io itself */
   instruction io_call = instruction_undefined;
   /* virtual tests to implement ERR= and END= clauses */
   statement io_err = statement_undefined;
   statement io_end = statement_undefined;
   expression unit = expression_undefined;
  
   for (l = lci; l != NULL; l = CDR(CDR(l))) {
     syntax s1;
     entity e1;
  
     s1 = expression_syntax(EXPRESSION(CAR(l)));
  
     e1 = call_function(syntax_call(s1));
  
     if (strcmp(entity_local_name(e1), "UNIT=") == 0) {
       if( ! expression_undefined_p(unit) )
         free_expression(unit);
       unit = EXPRESSION(CAR(CDR(l)));
     }
   }
  
   /* we scan the list of specifications to detect labels (such as in
      ERR=20, END=30, FMT=50, etc.), that were stored as integer constants
      (20, 30, 50) and that must be replaced by labels (_20, _30, _50). */
   for (l = lci; l != NULL; l = CDR(CDR(l))) {
     syntax s1, s2;
     entity e1, e2;
  
     s1 = expression_syntax(EXPRESSION(CAR(l)));
     s2 = expression_syntax(EXPRESSION(CAR(CDR(l))));
  
     pips_assert("syntax is a call", syntax_call_p(s1));
     e1 = call_function(syntax_call(s1));
     pips_assert("value is constant", value_constant_p(entity_initial(e1)));
     pips_assert("constant is not int (thus litteral or call)", 
                 !constant_int_p(value_constant(entity_initial(e1))));
  
     if (strcmp(entity_local_name(e1), "ERR=") == 0 || 
         strcmp(entity_local_name(e1), "END=") == 0 ||
         strcmp(entity_local_name(e1), "FMT=") == 0) {
       if (syntax_call_p(s2)) {
         e2 = call_function(syntax_call(s2));
         if (value_constant_p(entity_initial(e2))) {
           if (constant_int_p(value_constant(entity_initial(e2)))) {
             /* here is a label */
             call_function(syntax_call(s2)) = 
               MakeLabel(entity_local_name(e2));
           }
         }
         e2 = call_function(syntax_call(s2));
         if (strcmp(entity_local_name(e1), "FMT=") != 0
             && expression_undefined_p(unit)) {
           /* UNIT is not defined for INQUIRE (et least)
            * Let's use LUN 0 by default for END et ERR.
            */
           unit = int_to_expression(0);
         }
         if (strcmp(entity_local_name(e1), "ERR=") == 0) {
           io_err = make_check_io_statement(IO_ERROR_ARRAY_NAME, unit, e2);
         }
         else if (strcmp(entity_local_name(e1), "END=") == 0) {
           io_end = make_check_io_statement(IO_EOF_ARRAY_NAME, unit, e2);
         }
         else {
           //free_expression(unit);
           ;
     }
       }
     }
   }
  
   /*
     for (l = lci; CDR(l) != NULL; l = CDR(l)) ;
  
     CDR(l) = lio;
     l = lci;
   */
  
   lci = gen_nconc(lci, lio);
  
   io_call = make_instruction(is_instruction_call,
                              make_call(CreateIntrinsic(NameOfToken(keyword)),
                                        lci));
  
   if(statement_undefined_p(io_err) && statement_undefined_p(io_end)) {
     io = io_call;
   }
   else {
     list ls = NIL;
     if(!statement_undefined_p(io_err)) {
       ls = CONS(STATEMENT, io_err, ls);
     }
     if(!statement_undefined_p(io_end)) {
       ls = CONS(STATEMENT, io_end, ls);
     }
     ls = CONS(STATEMENT, MakeStatement(entity_empty_label(), io_call), ls);
     io = make_instruction(is_instruction_sequence, make_sequence(ls));
     instruction_consistent_p(io);
   }
     
   return io;
 }

References call_function, CAR, CDR, CONS, constant_int_p, CreateIntrinsic(), entity_empty_label(), entity_initial, entity_local_name(), EXPRESSION, expression_syntax, expression_undefined, expression_undefined_p, free_expression(), gen_nconc(), instruction_consistent_p(), instruction_undefined, int_to_expression(), IO_EOF_ARRAY_NAME, IO_ERROR_ARRAY_NAME, is_instruction_call, is_instruction_sequence, make_call(), make_check_io_statement(), make_instruction(), make_sequence(), MakeLabel(), MakeStatement(), NameOfToken(), NIL, pips_assert, s1, STATEMENT, statement_undefined, statement_undefined_p, syntax_call, syntax_call_p, value_constant, and value_constant_p.

Referenced by MakeSimpleIoInst1().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeIoInstB()

instruction MakeIoInstB	(	int	keyword,
		expression	e1,
		expression	e2,
		expression	e3,
		expression	e4
	)

this function creates a BUFFER IN or BUFFER OUT io statement.

this is not ansi fortran.

e1 is the logical unit.

nobody known the exact meaning of e2

e3 et e4 are references that indicate which variable elements are to be buffered in or out.

Parameters

keyword	eyword
e1	1
e2	2
e3	3
e4	4

Definition at line 1837 of file statement.c.

 {
     cons * l;
  
     l = CONS(EXPRESSION, e1, 
              CONS(EXPRESSION, e2,
                   CONS(EXPRESSION, e3,
                        CONS(EXPRESSION, e4, NULL))));
  
     return(make_instruction(is_instruction_call,
                             make_call(CreateIntrinsic(NameOfToken(keyword)),
                                       l)));
 }

References CONS, CreateIntrinsic(), EXPRESSION, is_instruction_call, make_call(), make_instruction(), and NameOfToken().

Here is the call graph for this function:

◆ MakeIoList()

cons* MakeIoList ( cons * l )

This function takes a list of io elements (i, j, t(i,j)), and returns the same list, with a cons cell pointing to a character constant expression 'IOLIST=' before each element of the original list.

(i , j , t(i,j)) becomes ('IOLIST=' , i , 'IOLIST=' , j , 'IOLIST=' , t(i,j))

This IO list is later concatenated to the IO control list to form the argument of an IO function. The tagging is necessary because of this concatenation.

The IOLIST call used to be shared within one IO list. Since sharing is avoided in the PIPS internal representation, they are now duplicated.

to walk thru l

result list

Definition at line 468 of file expression.c.

 {
     cons *pc; /* to walk thru l */
     cons *lr = NIL; /* result list */
                 
     pc = l;
     while (pc != NULL) {
         expression e = MakeCharacterConstantExpression(IO_LIST_STRING_NAME);
         cons *p = CONS(EXPRESSION, e, NIL);
  
         CDR(p) = pc;
         pc = CDR(pc);
         CDR(CDR(p)) = NIL;
  
         lr = gen_nconc(p, lr);
     }
  
     return(lr);
 }

References CDR, CONS, EXPRESSION, gen_nconc(), IO_LIST_STRING_NAME, MakeCharacterConstantExpression(), and NIL.

Here is the call graph for this function:

◆ MakeLabel()

entity MakeLabel ( const char * )

◆ MakeLogicalIfInst()

instruction MakeLogicalIfInst	(	expression	e,
		instruction	i
	)

this function creates a logical if statement.

the true part of the test is a block with only one instruction (i), and the false part is an empty block.

Modifications:

there is no need for a block in the true branch, any statement can do
there is no need for a CONTINUE statement in the false branch, an empty block is plenty
MakeStatement() cannot be used for the true and false branches because it disturbs the statement numering

It is not easy to number bt because Yacc reduction order does not help...

Instruction i should not be a block, unless:

an alternate return
a computed GO TO
an assigned GO TO has been desugared.

If the logical IF is labelled, the label has been stolen by the first statement in the block. This shows that label should only be affected by MakeStatement and not by desugaring routines.

statement first = STATEMENT(CAR(l));

Only the alternate return case assert: pips_assert("Block of two instructions or call with return code checks", (gen_length(l)==2 && assignment_statement_p(first)) || (statement_call_p(first)) );

Definition at line 1329 of file statement.c.

 {
   /* It is not easy to number bt because Yacc reduction order does not help... */
     statement bt = instruction_to_statement(i);
     statement bf = make_empty_block_statement();
     expression cond = fix_if_condition(e);
     instruction ti = make_instruction(is_instruction_test, 
                                       make_test(cond, bt, bf));
                                       
     if (i == instruction_undefined)
             FatalError("MakeLogicalIfInst", "bad instruction\n");
  
     /* Instruction i should not be a block, unless:
      * - an alternate return 
      * - a computed GO TO
      * - an assigned GO TO
      * has been desugared.
      *
      * If the logical IF is labelled, the label has been stolen by the
      * first statement in the block. This shows that label should only
      * be affected by MakeStatement and not by desugaring routines.
      */
     if(instruction_block_p(i)) {
         list l = instruction_block(i);
         /* statement first = STATEMENT(CAR(l)); */
         /* Only the alternate return case assert:
         pips_assert("Block of two instructions or call with return code checks",
                     (gen_length(l)==2 && assignment_statement_p(first))
                     ||
                     (statement_call_p(first))
             );
             */
         MAP(STATEMENT, s, {
             statement_number(s) = get_statement_number ();
         }, l);
     }
     else {
         statement_number(bt) = get_statement_number();
     }
  
     return ti;
 }

References FatalError, fix_if_condition(), get_statement_number(), instruction_block, instruction_block_p, instruction_to_statement(), instruction_undefined, is_instruction_test, make_empty_block_statement(), make_instruction(), make_test(), MAP, STATEMENT, and statement_number.

Here is the call graph for this function:

◆ MakeNewLabelledStatement()

statement MakeNewLabelledStatement	(	entity	l,
		instruction	i
	)

Associate label to the first statement in the block because block cannot be labelled.

Definition at line 289 of file statement.c.

 {
     statement s;
  
     debug(9, "MakeNewLabelledStatement", "begin for label \"%s\" and instruction %s\n",
           label_local_name(l), instruction_identification(i));
  
     if(instruction_loop_p(i) && get_bool_property("PARSER_SIMPLIFY_LABELLED_LOOPS")) {
         statement c = make_continue_statement(l);
         statement ls = instruction_to_statement(i);
  
         statement_number(ls) = get_statement_number();//get_next_statement_number();
         NewStmt(l, c);
         s = make_block_statement(CONS(STATEMENT,c,
                                       CONS(STATEMENT, ls, NIL)));
     }
     else if(instruction_block_p(i)) {
         /* Associate label to the first statement in the block because
          * block cannot be labelled.
          */
         statement s1 = STATEMENT(CAR(instruction_block(i)));
  
         statement_label(s1) = l;
         NewStmt(l, s1);
         s = make_statement(entity_empty_label(),
                            STATEMENT_NUMBER_UNDEFINED,
                            STATEMENT_ORDERING_UNDEFINED,
                            empty_comments,
                            i, NIL, NULL, empty_extensions (), make_synchronization_none());
     }
     else {
         s = make_statement(l,
                            (instruction_goto_p(i))?
                            STATEMENT_NUMBER_UNDEFINED : get_statement_number(),//get_next_statement_number(),
                            STATEMENT_ORDERING_UNDEFINED,
                            empty_comments,
                            i, NIL, NULL, empty_extensions (), make_synchronization_none());
         NewStmt(l, s);
     }
  
     debug(9, "MakeNewLabelledStatement", "end for label \"%s\"\n",
           label_local_name(l));
  
     return s;
 }

References CAR, CONS, debug(), empty_comments, empty_extensions(), entity_empty_label(), get_bool_property(), get_statement_number(), instruction_block, instruction_block_p, instruction_goto_p, instruction_identification(), instruction_loop_p, instruction_to_statement(), label_local_name(), make_block_statement(), make_continue_statement(), make_statement(), make_synchronization_none(), NewStmt(), NIL, s1, STATEMENT, statement_label, statement_number, STATEMENT_NUMBER_UNDEFINED, and STATEMENT_ORDERING_UNDEFINED.

Referenced by MakeStatement().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeParameter()

entity MakeParameter	(	entity	e,
		expression	x
	)

lint

this function creates a PARAMETER, ie a symbolic constant.

e is an entity.

x is an expression that represents the value of e.

Take the integer part of the floating point constant

Definition at line 52 of file expression.c.

 {
     type tp;
  
     tp = (entity_type(e) != type_undefined) ? entity_type(e) : ImplicitType(e);
     entity_type(e) = make_type(is_type_functional, make_functional(NIL, tp));
     if(storage_undefined_p(entity_storage(e))) {
         entity_storage(e) = make_storage_rom();
     }
     else {
         if(storage_ram_p(entity_storage(e))) {
             user_warning("MakeParameter", "Variable %s redefined as parameter\n",
                          entity_local_name(e));
             ParserError("MakeParameter", "A variable cannot be redefined as a parameter\n");
         }
         else {
             user_warning("MakeParameter", "Symbol %s redefined as parameter\n",
                          entity_local_name(e));
             ParserError("MakeParameter", "A symbol cannot be redefined as a parameter\n");
         }
     }
     if(value_undefined_p(entity_initial(e)) || value_unknown_p(entity_initial(e))) {
       value v =  MakeValueSymbolic(x);
       symbolic s = value_symbolic(v);
       constant c = symbolic_constant(s);
       if(constant_int_p(c) && scalar_integer_type_p(tp))
         entity_initial(e) = v;
       else if(constant_float_p(c) && float_type_p(tp))
         entity_initial(e) = v;
       else if(constant_float_p(c) && scalar_integer_type_p(tp)) {
         /* Take the integer part of the floating point constant */
         double fval = constant_float(c);
         long long int ival = (long long int) fval;
         constant_tag(c) = is_constant_int;
         constant_int(c) = ival;
         entity_initial(e) = v;
       }
       else
         entity_initial(e) = v;
     }
     else {
         user_warning("MakeParameter", "Initial value for variable %s redefined\n",
                      entity_local_name(e));
         FatalError("MakeParameter", "An initial value cannot be redefined by parameter\n");
     }
  
     return(e);
 }

References constant_float, constant_float_p, constant_int, constant_int_p, constant_tag, entity_initial, entity_local_name(), entity_storage, entity_type, FatalError, float_type_p(), ImplicitType(), int, is_constant_int, is_type_functional, make_functional(), make_storage_rom(), make_type(), MakeValueSymbolic(), NIL, ParserError(), scalar_integer_type_p(), storage_ram_p, storage_undefined_p, symbolic_constant, type_undefined, user_warning, value_symbolic, value_undefined_p, value_unknown_p, and x.

Referenced by step_parameter().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeResultType()

type MakeResultType	(	entity	e,
		type	r
	)

The result type of a function may be carried by e, by r or be implicit.

A new type structure is allocated, unless r is used as new result type.

e is a function that was implicitly declared as a variable. this may happen in Fortran.

pips_assert("undefined type", r == type_undefined);

The variable may have been typed, for instance implicitly, but then it appears in a CALL statement and its new type is void. Added for formal parameters.

Well... this should be useless because e is already typed. FI: I do not believe copy_type() is necessary in spite of the non orthogonality...

Definition at line 1754 of file procedure.c.

 {
     type te = entity_type(e);
     type new_r = type_undefined;
  
     if (te != type_undefined) {
         if (type_variable_p(te)) {
             /* e is a function that was implicitly declared as a variable.
                this may happen in Fortran. */
             pips_debug(2, "variable --> fonction\n");
             /* pips_assert("undefined type", r == type_undefined); */
             if(type_undefined_p(r))
               new_r = copy_type(te);
             else {
               /* The variable may have been typed, for instance
                  implicitly, but then it appears in a CALL statement and
                  its new type is void. Added for formal parameters. */
               pips_assert("The new result type is void", type_void_p(r));
               new_r = r;
             }
         }
         else if (type_functional_p(te)) {
             /* Well... this should be useless because e is already typed.
              * FI: I do not believe copy_type() is necessary in spite of
              * the non orthogonality...
              */
             new_r = functional_result(type_functional(te));
         }
         else {
             pips_internal_error("Unexpected type %s for entity %s",
                        type_to_string(te), entity_name(e));
         }
     }
     else {
         if(type_undefined_p(r)) {
             new_r = ImplicitType(e);
         }
         else {
             new_r = r;
         }
     }
     pips_assert("type new_r is defined", !type_undefined_p(new_r));
     return new_r;
 }

References copy_type(), entity_name, entity_type, functional_result, ImplicitType(), pips_assert, pips_debug, pips_internal_error, type_functional, type_functional_p, type_to_string(), type_undefined, type_undefined_p, type_variable_p, and type_void_p.

Referenced by MakeEntry(), and MakeExternalFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeReturn()

instruction MakeReturn ( expression e )

Assign e to the return code variable, but be sure not to count this assignment as a user instruction. Wrap if with the Go To in a block and return the block instruction.

See how code is synthesized for computed goto's...

Let's try to provide more useful information to the user

inst = MakeZeroOrOneArgCallInst("STOP", e);

Definition at line 445 of file return.c.

 {
   instruction inst = instruction_undefined;
  
   if(!expression_undefined_p(e) && !substitute_rc_p && !substitute_stop_p) {
     user_error("MakeReturn",
                "Lines %d-%d: Alternate return not supported. "
                "Standard return generated\n",
                line_b_I,line_e_I);
   }
  
   if (end_label == entity_undefined) {
     end_label = MakeLabel(end_label_local_name);
   }
  
   if(substitute_rc_p && uses_alternate_return_p()) {
     /* Assign e to the return code variable, but be sure not to count
      * this assignment as a user instruction. Wrap if with the Go To
      * in a block and return the block instruction.
      *
      * See how code is synthesized for computed goto's...
      */
     statement src = make_set_rc_statement(e);
     statement jmp = instruction_to_statement(MakeGotoInst(end_label_local_name));
  
     statement_number(src) = get_statement_number();
     statement_number(jmp) = get_statement_number();
     //    (void) get_next_statement_number();
     inst = make_instruction_block(CONS(STATEMENT, src, CONS(STATEMENT, jmp, NIL)));
     instruction_consistent_p(inst);
   }
   else if(!expression_undefined_p(e) && substitute_stop_p && uses_alternate_return_p()) {
     /* Let's try to provide more useful information to the user */
     /* inst = MakeZeroOrOneArgCallInst("STOP", e); */
     if(expression_call_p(e)) {
       const char* mn = get_current_module_name();
       const char* sn = entity_local_name(call_function(syntax_call(expression_syntax(e))));
  
       inst = MakeZeroOrOneArgCallInst
         ("STOP",
          MakeCharacterConstantExpression(strdup(concatenate("\"", sn, " in ", mn, "\"", NULL))));
     }
     else {
       pips_internal_error("unexpected argument type for RETURN");
     }
   }
   else {
     inst = MakeGotoInst(end_label_local_name);
   }
  
   return inst;
 }

References call_function, concatenate(), CONS, end_label, end_label_local_name, entity_local_name(), entity_undefined, expression_call_p(), expression_syntax, expression_undefined_p, get_current_module_name(), get_statement_number(), instruction_consistent_p(), instruction_to_statement(), instruction_undefined, line_b_I, line_e_I, make_instruction_block(), make_set_rc_statement(), MakeCharacterConstantExpression(), MakeGotoInst(), MakeLabel(), MakeZeroOrOneArgCallInst(), NIL, pips_internal_error, src, STATEMENT, statement_number, strdup(), substitute_rc_p, substitute_stop_p, syntax_call, user_error, and uses_alternate_return_p().

Here is the call graph for this function:

◆ MakeSimpleIoInst1()

instruction MakeSimpleIoInst1	(	int	keyword,
		expression	unit
	)

Functionally PRINT is a special case of WRITE

Parameters

keyword eyword

Definition at line 1854 of file statement.c.

 {
     instruction inst = instruction_undefined;
     expression std, format, unite;
     cons * lci;
  
     switch(keyword) {
     case TK_READ:
     case TK_PRINT:
         std = MakeNullaryCall(CreateIntrinsic
                               (LIST_DIRECTED_FORMAT_NAME));
         unite = MakeCharacterConstantExpression("UNIT=");
         format = MakeCharacterConstantExpression("FMT=");
  
         lci = CONS(EXPRESSION, unite,
                    CONS(EXPRESSION, std,
                         CONS(EXPRESSION, format,
                              CONS(EXPRESSION, unit, NULL))));
         /* Functionally PRINT is a special case of WRITE */
         inst = MakeIoInstA((keyword==TK_PRINT)?TK_WRITE:TK_READ,
                          lci, NIL);
         break;
     case TK_WRITE:
     case TK_OPEN:
     case TK_CLOSE:
     case TK_INQUIRE:
       ParserError("Syntax",
                   "Illegal syntax in IO statement, "
                   "Parentheses and arguments required");
       break;
     case TK_BACKSPACE:
     case TK_REWIND:
     case TK_ENDFILE:
         unite = MakeCharacterConstantExpression("UNIT=");
         lci = CONS(EXPRESSION, unite,
                    CONS(EXPRESSION, unit, NULL));
         inst = MakeIoInstA(keyword, lci, NIL);
         break;
     default:
         ParserError("Syntax","Unexpected token in IO statement");
     }
     return inst;
 }

References CONS, CreateIntrinsic(), EXPRESSION, instruction_undefined, LIST_DIRECTED_FORMAT_NAME, MakeCharacterConstantExpression(), MakeIoInstA(), MakeNullaryCall(), NIL, ParserError(), TK_BACKSPACE, TK_CLOSE, TK_ENDFILE, TK_INQUIRE, TK_OPEN, TK_PRINT, TK_READ, TK_REWIND, and TK_WRITE.

Here is the call graph for this function:

◆ MakeSimpleIoInst2()

instruction MakeSimpleIoInst2	(	int	keyword,
		expression	f,
		list	io_list
	)

Parameters

keyword	eyword
io_list	o_list

Definition at line 1899 of file statement.c.

 {
     instruction inst = instruction_undefined;
     //expression std, format, unite;
     //list cil;
  
     switch(keyword) {
     case TK_READ:
       inst = make_simple_Fortran_io_instruction(true, f, io_list);
       break;
     case TK_PRINT:
       inst = make_simple_Fortran_io_instruction(false, f, io_list);
         break;
     case TK_WRITE:
     case TK_OPEN:
     case TK_CLOSE:
     case TK_INQUIRE:
     case TK_BACKSPACE:
     case TK_REWIND:
     case TK_ENDFILE:
       ParserError("Syntax",
                     "Illegal syntax in IO statement, Parentheses are required");
       break;
     default:
       ParserError("Syntax","Unexpected token in IO statement");
     }
     return inst;
 }

References f(), instruction_undefined, make_simple_Fortran_io_instruction(), ParserError(), TK_BACKSPACE, TK_CLOSE, TK_ENDFILE, TK_INQUIRE, TK_OPEN, TK_PRINT, TK_READ, TK_REWIND, and TK_WRITE.

Referenced by make_print_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeStatement()

statement MakeStatement	(	entity	l,
		instruction	i
	)

This function makes a statement.

l is the label and i the instruction. We make sure that the label is not declared twice.

Comments are added by LinkInstToCurrentBlock() which calls MakeStatement() because it links the instruction by linking its statement..

GO TO statements are numbered like other statements although they are destroyed by the controlizer. To be changed.

There is an actual label

Well, there is no easy solution to handle labels when Fortran constructs such as alternate returns, computed gotos and assigned gotos are desugared because they may be part of a logical IF, unknowingly.

FI, PJ: the "rice" phase does not handle labels on DO like 100 in: 100 DO 200 I = 1, N

This should be trapped by "rice" when loops are checked to see if Allen/Kennedy's algorithm is applicable

There is not forward reference to the this label. A new statement can be safely allocated.

A forward reference has been encountered and the corresponding statement has been allocated and has been referenced by at least one go to statement.

The CONTINUE slot can be re-used. It is likely to be an artificial CONTINUE added to carry a comment. Maybe it would be better to manage lab_I in a more consistent way by resetting it as soon as it is used. But I did not find the reset!

}

No actual label, no problem

Definition at line 431 of file statement.c.

 {
     statement s;
  
     debug(5, "MakeStatement", "Begin for label %s and instruction %s\n",
           entity_name(l), instruction_identification(i));
  
     pips_assert("MakeStatement", type_statement_p(entity_type(l)));
     pips_assert("MakeStatement", storage_rom_p(entity_storage(l)));
     pips_assert("MakeStatement", value_constant_p(entity_initial(l)));
     pips_assert("MakeStatement", 
                 constant_litteral_p(value_constant(entity_initial(l))));
  
     if (!entity_empty_label_p(l)) {
         /* There is an actual label */
  
         /* Well, there is no easy solution to handle labels when Fortran 
          * constructs such as alternate returns, computed gotos and 
          * assigned gotos are desugared because they may be part of a 
          * logical IF, unknowingly.
          */
         /*
           if (instruction_block_p(i))
           ParserError("makeStatement", "a block must have no label\n");
         */
  
         /* FI, PJ: the "rice" phase does not handle labels on DO like 100 in:
          *  100 DO 200 I = 1, N
          *
          * This should be trapped by "rice" when loops are checked to see
          * if Allen/Kennedy's algorithm is applicable
          */
         if (instruction_loop_p(i)) {
             if(!get_bool_property("PARSER_SIMPLIFY_LABELLED_LOOPS")) {
                 user_warning("MakeStatement",
                              "DO loop reachable by GO TO via label %s "
                              "cannot be parallelized by PIPS\n",
                              entity_local_name(l));
             }
         }
  
         if ((s = LabelToStmt(entity_name(l))) == statement_undefined) {
             /* There is not forward reference to the this label. A new statement 
              * can be safely allocated.
              */
             s = MakeNewLabelledStatement(l,i);
         }
         else {
             /* A forward reference has been encountered and the corresponding
              * statement has been allocated and has been referenced by at least
              * one go to statement.
              */
  
             if(statement_instruction(s) != instruction_undefined) {
                     /* The CONTINUE slot can be re-used. It is likely to
                     be an artificial CONTINUE added to carry a
                     comment. Maybe it would be better to manage lab_I in a
                     more consistent way by resetting it as soon as it is
                     used. But I did not find the reset! */
                 /*
                 if(statement_continue_p(s)) {
                     free_instruction(statement_instruction(s));
                     statement_instruction(s) = instruction_undefined;
                     statement_number(s) = STATEMENT_NUMBER_UNDEFINED;
                 }
                 else {
                     */
                     user_warning("MakeStatement", "Label %s may be used twice\n",
                                  entity_local_name(l));
                     ParserError("MakeStatement", "Same label used twice\n");
                     /* } */
             }
             s = ReuseLabelledStatement(s, i);
         }
     }
     else {
         /* No actual label, no problem */
         s = make_statement(l,
                            (instruction_goto_p(i)||instruction_block_p(i))?
                            STATEMENT_NUMBER_UNDEFINED : get_statement_number(), //get_next_statement_number(),
                            STATEMENT_ORDERING_UNDEFINED,
                            empty_comments,
                            i,NIL,NULL, empty_extensions (), make_synchronization_none());
     }
  
     return(s);
 }

References constant_litteral_p, debug(), empty_comments, empty_extensions(), entity_empty_label_p(), entity_initial, entity_local_name(), entity_name, entity_storage, entity_type, get_bool_property(), get_statement_number(), instruction_block_p, instruction_goto_p, instruction_identification(), instruction_loop_p, instruction_undefined, LabelToStmt(), make_statement(), make_synchronization_none(), MakeNewLabelledStatement(), NIL, ParserError(), pips_assert, ReuseLabelledStatement(), statement_instruction, STATEMENT_NUMBER_UNDEFINED, STATEMENT_ORDERING_UNDEFINED, statement_undefined, storage_rom_p, type_statement_p, user_warning, value_constant, and value_constant_p.

Referenced by GenerateReturn(), LinkInstToCurrentBlock(), MakeBlockIfInst(), and MakeIoInstA().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeVariableStatic()

void MakeVariableStatic	(	entity	v,
		bool	force_it
	)

v may have become static because of a DATA statement (OK) or because of another SAVE (NOK)

Could be the stack or the heap area or any common

Parameters

force_it orce_it

Definition at line 245 of file declaration.c.

 {
   if(entity_storage(v) == storage_undefined) {
     SaveEntity(v);
   }
   else if(storage_ram_p(entity_storage(v))) {
     entity a = ram_section(storage_ram(entity_storage(v)));
     if(a==DynamicArea) {
       SaveEntity(v);
     }
     else if(a==StaticArea) {
       /* v may have become static because of a DATA statement (OK)
        * or because of another SAVE (NOK)
        */
     }
     else {
       /* Could be the stack or the heap area or any common */
       if(force_it) {
       user_warning("ProcessSave", "Variable %s has already been declared static "
                    "by appearing in Common %s\n",
                    entity_local_name(v), module_local_name(a));
       ParserError("parser", "SAVE statement incompatible with previous"
                   " COMMON declaration\n");
       }
       else {
       }
     }
   }
   else {
     user_warning("parser", "Variable %s cannot be declared static "
                  "be cause of its storage class (tag=%d)\n",
                  entity_local_name(v), storage_tag(entity_storage(v)));
     ParserError("parser", "SAVE statement incompatible with previous"
                   " declaration (e.g. EXTERNAL).\n");
   }
 }

References DynamicArea, entity_local_name(), entity_storage, module_local_name(), ParserError(), ram_section, SaveEntity(), StaticArea, storage_ram, storage_ram_p, storage_tag, storage_undefined, and user_warning.

Referenced by ProcessSave(), and save_initialized_variable().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MakeWhileDoInst()

void MakeWhileDoInst	(	expression	c,
		string	l
	)

This function creates a while do loop statement.

c is the loop condition l is the label of the last statement of the loop.

with the f77 compiler, this is equivalent to c.NE.0

Definition at line 1262 of file statement.c.

 {
     instruction iwdo, instblock_do;
     statement stmt_do;
     entity dolab;
     expression cond = expression_undefined;
  
     if(!logical_expression_p(c)) {
       /* with the f77 compiler, this is equivalent to c.NE.0*/
       cond = MakeBinaryCall(entity_intrinsic(NON_EQUAL_OPERATOR_NAME),
                             c, int_to_expression(0));
       pips_user_warning("WHILE condition between lines %d and %d is not a logical expression.\n",
                         line_b_I,line_e_I);
     }
     else {
       cond = c;
     }
  
     dolab = MakeLabel((strcmp(l, "BLOCKDO") == 0) ? "" : l);
  
     instblock_do = MakeEmptyInstructionBlock();
     stmt_do = instruction_to_statement(instblock_do);
  
     iwdo = make_instruction(is_instruction_whileloop,
                            make_whileloop(cond, stmt_do, dolab,make_evaluation_before()));
  
     LinkInstToCurrentBlock(iwdo, true);
    
     PushBlock(instblock_do, l);
 }

References entity_intrinsic(), expression_undefined, instruction_to_statement(), int_to_expression(), is_instruction_whileloop, line_b_I, line_e_I, LinkInstToCurrentBlock(), logical_expression_p(), make_evaluation_before(), make_instruction(), make_whileloop(), MakeBinaryCall(), MakeEmptyInstructionBlock(), MakeLabel(), NON_EQUAL_OPERATOR_NAME, pips_user_warning, and PushBlock().

Here is the call graph for this function:

◆ MakeZeroOrOneArgCallInst()

instruction MakeZeroOrOneArgCallInst	(	char *	s,
		expression	e
	)

this function creates a simple Fortran statement such as RETURN, CONTINUE, ...

s is the name of the intrinsic function.

e is one optional argument (might be equal to expression_undefined).

la liste d'arguments

Definition at line 669 of file statement.c.

 {
     cons *l; /* la liste d'arguments */
  
     l = (e == expression_undefined) ? NIL : CONS(EXPRESSION, e, NIL);
  
     return(make_instruction(is_instruction_call, 
                             make_call(CreateIntrinsic(s), l)));
 }

References CONS, CreateIntrinsic(), EXPRESSION, expression_undefined, is_instruction_call, make_call(), make_instruction(), and NIL.

Referenced by GenerateReturn(), gfc2pips_code2instruction__TOP(), MakeAssignedOrComputedGotoInst(), and MakeReturn().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ MergeTwoChains()

cons* MergeTwoChains	(	cons *	opc1,
		cons *	opc2
	)

this function merges two equivalence chains whose intersection is not empty, ie.

one variable occurs in both chains.

Parameters

opc1	pc1
opc2	pc2

Definition at line 322 of file equivalence.c.

 {
     int deltaoff;
     cons *pctemp, *pc1, *pc2=NIL;
  
     for (pc1 = opc1; pc1 != NIL; pc1 = CDR(pc1)) {
         for (pc2 = opc2; pc2 != NIL; pc2 = CDR(pc2)) {
             if (gen_eq((atom_equivar(ATOM(CAR(pc1)))),
                        (atom_equivar(ATOM(CAR(pc2)))))) {
                 break;
             }
         }
         if (pc2 != NIL)
                 break;
     }
  
     if (pc1 == NIL || pc2 == NIL)
             FatalError("MergeTwoChains", "empty intersection\n");
  
     deltaoff = atom_equioff(ATOM(CAR(pc1)))-atom_equioff(ATOM(CAR(pc2)));
  
     if (deltaoff < 0) {
         pctemp = opc2; opc2 = opc1; opc1 = pctemp;
     }
     pc1 = opc1;
     pc2 = opc2;
  
     while (1) {
         atom_equioff(ATOM(CAR(pc2))) += abs(deltaoff);
         if (CDR(pc2) == NIL)
                 break;
         pc2 = CDR(pc2);
     }
  
     CDR(pc2) = pc1;
     return(opc2);
 }

References abs, ATOM, atom_equioff, atom_equivar, CAR, CDR, FatalError, gen_eq(), and NIL.

Referenced by AddOrMergeChain().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ NameOfToken()

string NameOfToken ( int token )

just to avoid a gcc warning

Parameters

token oken

Definition at line 1636 of file statement.c.

 {
     string name;
  
     switch (token) {
       case TK_BUFFERIN: 
         name = "BUFFERIN"; 
         break;
       case TK_BUFFEROUT: 
         name = "BUFFEROUT"; 
         break;
       case TK_INQUIRE: 
         name = "INQUIRE"; 
         break;
       case TK_OPEN: 
         name = "OPEN"; 
         break;
       case TK_CLOSE: 
         name = "CLOSE"; 
         break;
       case TK_PRINT: 
         name = "PRINT"; 
         break;
       case TK_READ: 
         name = "READ"; 
         break;
       case TK_REWIND: 
         name = "REWIND"; 
         break;
       case TK_WRITE: 
         name = "WRITE"; 
         break;
       case TK_ENDFILE: 
         name = "ENDFILE"; 
         break;
       case TK_BACKSPACE: 
         name = "BACKSPACE"; 
         break;
       default:
         FatalError("NameOfToken", "unknown token\n");
         name = string_undefined; /* just to avoid a gcc warning */
         break;
     }
  
     return(name);
 }

References FatalError, string_undefined, TK_BACKSPACE, TK_BUFFERIN, TK_BUFFEROUT, TK_CLOSE, TK_ENDFILE, TK_INQUIRE, TK_OPEN, TK_PRINT, TK_READ, TK_REWIND, and TK_WRITE.

Referenced by MakeIoInstA(), and MakeIoInstB().

Here is the caller graph for this function:

◆ NameToCommon()

entity NameToCommon ( string n )

Check for potential conflicts

Definition at line 1071 of file declaration.c.

 {
     string c_name = strdup(concatenate(COMMON_PREFIX, n, NULL));
     entity c = FindOrCreateEntity(TOP_LEVEL_MODULE_NAME, c_name);
     string prefixes[] = {"", MAIN_PREFIX, BLOCKDATA_PREFIX, NULL};
     string nature[] = {"function or subroutine", "main", "block data"};
     int i = 0;
  
     c = MakeCommon(c);
     free(c_name);
  
     /* Check for potential conflicts */
     for(i=0; prefixes[i]!=NULL; i++) {
         string name = strdup(concatenate(prefixes[i], n, NULL));
         entity ce = FindEntity(TOP_LEVEL_MODULE_NAME, name);
  
         if(!entity_undefined_p(ce)) {
             user_warning("NameToCommon", "Identifier %s used for a common and for a %s\n",
                          n, nature[i]);
         }
  
         free(name);
     }
  
     return c;
 }

References BLOCKDATA_PREFIX, COMMON_PREFIX, concatenate(), entity_undefined_p, FindEntity(), FindOrCreateEntity(), free(), MAIN_PREFIX, MakeCommon(), prefixes, strdup(), TOP_LEVEL_MODULE_NAME, and user_warning.

Here is the call graph for this function:

◆ NameToFunctionalEntity()

entity NameToFunctionalEntity ( string name )

Ignore ghost variables, they are not in the current scope

The functional entity must be a formal parameter

The current declaration is wrong and should be fixed later, i.e. by MakeExternalFunction() or MakeCallInst()

It is the name of a blockdata

Parameters

name ame

Definition at line 2217 of file procedure.c.

 {
     entity f = gen_find_tabulated
         (concatenate(TOP_LEVEL_MODULE_NAME, MODULE_SEP_STRING,
                      BLOCKDATA_PREFIX, name, NULL),
          entity_domain);
  
     if(entity_undefined_p(f)) {
         f = gen_find_tabulated
             (concatenate(CurrentPackage, MODULE_SEP_STRING, name, NULL),
              entity_domain);
  
         /* Ignore ghost variables, they are *not* in the current scope */
         f = ghost_variable_entity_p(f)? entity_undefined : f;
  
         if(entity_undefined_p(f)) {
             f = FindOrCreateEntity(TOP_LEVEL_MODULE_NAME, name);
         }
         else if(!storage_undefined_p(entity_storage(f))
                 && storage_formal_p(entity_storage(f))) {
             /* The functional entity must be a formal parameter */
             ;
         }
         else if(storage_undefined_p(entity_storage(f))) {
             /* The current declaration is wrong and should be fixed
              * later, i.e. by MakeExternalFunction() or MakeCallInst()
              */
             ;
         }
         else {
             pips_assert("Unexpected kind of functional entity!", true);
         }
     }
     else {
         /* It is the name of a blockdata */
         ;
     }
     return f;
 }

References BLOCKDATA_PREFIX, concatenate(), CurrentPackage, entity_domain, entity_storage, entity_undefined, entity_undefined_p, f(), FindOrCreateEntity(), gen_find_tabulated(), ghost_variable_entity_p(), MODULE_SEP_STRING, pips_assert, storage_formal_p, storage_undefined_p, and TOP_LEVEL_MODULE_NAME.

Here is the call graph for this function:

◆ NeedKeyword()

int NeedKeyword ( void )

just to avoid a gcc warning

OTREACHED

Definition at line 1329 of file reader.c.

 {
     register int i, j;
     char * kwcour;
  
     i = keywidx[(int) stmt_buffer[iStmt]-'A'];
  
     if (i != UNDEF) {
         while ((kwcour = keywtbl[i].keywstr)!=0 && 
                kwcour[0]==stmt_buffer[iStmt]) {
             if (StmtEqualString(kwcour, iStmt) != false) {
                 j = CapitalizeStmt(kwcour, iStmt);
                 return(j);
             }
             i += 1;
         }
     }
  
     ParserError("NeedKeyword", "[scanner] keyword expected\n");
  
     return(-1); /* just to avoid a gcc warning */
                   
     /*NOTREACHED*/
 }

References CapitalizeStmt(), int, iStmt, keywidx, keywtbl, ParserError(), stmt_buffer, StmtEqualString(), and UNDEF.

Referenced by FindAutre(), and FindImplicit().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ NewStmt()

void NewStmt	(	entity	e,
		statement	s
	)

this function stores a new association in table StmtHeap: the label of statement s is e.

Definition at line 141 of file statement.c.

 {
   init_StmtHeap_buffer();
  
   pips_assert("The empty label is not associated to a statement",
               !entity_empty_label_p(e));
  
   pips_assert("Label e is the label of statement s", e==statement_label(s));
  
   if (LabelToStmt(entity_name(e)) != statement_undefined) {
     user_log("NewStmt: duplicate label: %s\n", entity_name(e));
     ParserError("NewStmt", "duplicate label\n");
   }
  
   if (CurrentStmt >= StmtHeap_buffer_size)
     resize_StmtHeap_buffer();
  
   StmtHeap_buffer[CurrentStmt].l = entity_name(e);
   StmtHeap_buffer[CurrentStmt].s = s;
   CurrentStmt += 1;
 }

References CurrentStmt, entity_empty_label_p(), entity_name, init_StmtHeap_buffer(), stmt::l, LabelToStmt(), ParserError(), pips_assert, resize_StmtHeap_buffer(), stmt::s, statement_label, statement_undefined, StmtHeap_buffer, StmtHeap_buffer_size, and user_log().

Referenced by make_goto_instruction(), and MakeNewLabelledStatement().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ OffsetOfReference()

int OffsetOfReference ( reference r )

This function computes the numerical offset of a variable element from the begining of the variable.

The variable must have numerical bounds for this function to work. It core dumps for adjustable arrays such as formal parameters.

Use a trick to retrieve the size in bytes of one array element and use the size of the previous dimension

Definition at line 1565 of file declaration.c.

 {
     cons *pi;
     int idim, iindex, pid, o, ilowerbound;
  
     pi = reference_indices(r);
  
     for (idim = 0, pid = 1, o = 0; pi != NULL; idim++, pi = CDR(pi)) {
         iindex = ExpressionToInt(EXPRESSION(CAR(pi)));
         ilowerbound = ValueOfIthLowerBound((reference_variable(r)), idim+1);
         /* Use a trick to retrieve the size in bytes of one array element
          * and use the size of the previous dimension
          */
         pid *= SizeOfIthDimension((reference_variable(r)), idim);
         o += ((iindex-ilowerbound)*pid);
     }
  
     return(o);  
 }

References CAR, CDR, EXPRESSION, ExpressionToInt(), reference_indices, reference_variable, SizeOfIthDimension(), and ValueOfIthLowerBound().

Referenced by MakeEquivAtom().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ parser()

bool parser ( const string )

Parameters

string odule

Definition at line 291 of file parser.c.

 {
     return the_actual_parser(module, DBR_SOURCE_FILE);
 }

References module, and the_actual_parser().

Here is the call graph for this function:

◆ parser_add_a_macro()

void parser_add_a_macro	(	call	c,
		expression	e
	)

resize!

expand macros in the macro! It is ok, because referenced macros must appear in preceding lines (F77 15-5, line 3-5).

store the result.

Definition at line 113 of file macros.c.

 {
     entity macro = call_function(c);
  
     pips_debug(5, "adding macro %s\n", entity_name(macro));
     pips_assert("macros support initialized", current_macros_size>0);
  
     if (current_macro_index>=current_macros_size) /* resize! */
     {
         current_macros_size*=2;
         current_macros = (macro_t*) 
             realloc(current_macros, sizeof(macro_t)*current_macros_size);
         pips_assert("realloc ok", current_macros);
     }
     
     if (find_entity_macro(macro) != NULL) {
       pips_user_warning("Macro \"%s\" is not yet defined.\n", 
                         entity_name(macro));
       ParserError("parser_add_a_macro",
                   "It may be an undeclared array.\n");
     }
  
     /* expand macros in the macro! It is ok, because
      * referenced macros must appear in preceding lines (F77 15-5, line 3-5).
      */
     parser_substitute_all_macros_in_expression(e);
  
     /* store the result.
      */
     current_macros[current_macro_index].lhs = c;
     current_macros[current_macro_index].rhs = e;
     current_macro_index++;
 }

References call_function, current_macro_index, current_macros, current_macros_size, entity_name, find_entity_macro(), macro_t::lhs, parser_substitute_all_macros_in_expression(), ParserError(), pips_assert, pips_debug, pips_user_warning, and macro_t::rhs.

Referenced by MakeAssignInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ parser_close_macros_support()

void parser_close_macros_support ( void )

what about the entity? It might exist such a real top-level entity... what if added as a callee... the entity should be destroyed... best would be to have it as a local entity, and have the calles and top-level updates delayed.

Definition at line 72 of file macros.c.

 {
     pips_debug(5, "closing macro-expansion support stuff\n");
  
     for (current_macro_index--; current_macro_index>=0; current_macro_index--)
     {
         call c;
         entity macro;
  
         free_expression(current_macros[current_macro_index].rhs);
         c = current_macros[current_macro_index].lhs;
  
         macro = call_function(c);
         free_call(c);
  
         /* what about the entity? 
          * It might exist such a real top-level entity...
          * what if added as a callee...
          * the entity should be destroyed...
          * best would be to have it as a local entity,
          * and have the calles and top-level updates delayed.
          */
         remove_from_called_modules(macro);
     }
 }

References call_function, current_macro_index, current_macros, free_call(), free_expression(), macro_t::lhs, pips_debug, and remove_from_called_modules().

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ parser_entity_macro_p()

bool parser_entity_macro_p ( entity e )

Definition at line 108 of file macros.c.

 {
     return find_entity_macro(e)==NULL;
 }

References find_entity_macro().

Here is the call graph for this function:

◆ parser_init_macros_support()

void parser_init_macros_support ( void )

macros.c

??? memory leak...

Definition at line 57 of file macros.c.

 {
     pips_debug(5, "initializing macro-expansion support stuff\n");
  
     current_macro_index = 0; /* ??? memory leak... */
     
     if (current_macros_size==0)
     {
         current_macros_size = 10;
         current_macros = (macro_t*)
             malloc(sizeof(macro_t)*current_macros_size);
         pips_assert("malloc ok", current_macros);
     }
 }

References current_macro_index, current_macros, current_macros_size, malloc(), pips_assert, and pips_debug.

Referenced by the_actual_parser().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ parser_macro_expansion()

void parser_macro_expansion ( expression e )

of expression

get the macro definition.

duplicated, for latter subs.

replace each formal by its actual.

MUST be a simple reference

if the replacement is a constant, or a reference without calls to external functions, it should be safe

it is important to keep the same expression, for gen_recurse use.

Definition at line 224 of file macros.c.

 {
     bool warned = false;
     macro_t * def;
     call c, lhs;
     entity macro;
     expression rhs;
     list /* of expression */ lactuals, lformals;
  
     if (!expression_call_p(e)) return;
     
     c = syntax_call(expression_syntax(e));
     macro = call_function(c);
     lactuals = call_arguments(c);
  
     /* get the macro definition. */
     def = find_entity_macro(macro);
  
     if (def==NULL) {
         pips_debug(5, "no macro definition for %s\n", entity_name(macro));
         return;
     }
  
     lhs = def->lhs;
     rhs = copy_expression(def->rhs); /* duplicated, for latter subs. */
  
     pips_assert("right macro function", macro == call_function(lhs));
     
     lformals = call_arguments(lhs);
  
     pips_assert("same #args", gen_length(lactuals)==gen_length(lformals));
  
     reset_substitute_expression_in_expression();
  
     /* replace each formal by its actual.
      */
     for (; !ENDP(lactuals); POP(lactuals), POP(lformals))
     {
         expression actu, form;
  
         form = EXPRESSION(CAR(lformals)); /* MUST be a simple reference */
         pips_assert("dummy arg ok", 
                     expression_reference_p(form) &&
           ENDP(reference_indices(syntax_reference(expression_syntax(form)))));
  
         /* if the replacement is a constant, or a reference without
          * calls to external functions, it should be safe 
          */
         actu = EXPRESSION(CAR(lactuals));
  
         if (!warned && untrusted_call_p(actu)) {
             pips_user_warning("maybe non safe substitution of macro %s!\n",
                               module_local_name(macro));
             warned = true;
         }
  
         substitute_expression_in_expression(rhs, form, actu);
     }
  
     reset_substitute_expression_in_expression();
  
     /* it is important to keep the same expression, for gen_recurse use.
      */
     free_syntax(expression_syntax(e));
     expression_syntax(e) = expression_syntax(rhs);
     expression_syntax(rhs) = syntax_undefined;
     free(rhs);
 }

References call_arguments, call_function, CAR, copy_expression(), ENDP, entity_name, EXPRESSION, expression_call_p(), expression_reference_p(), expression_syntax, find_entity_macro(), free(), free_syntax(), gen_length(), macro_t::lhs, module_local_name(), pips_assert, pips_debug, pips_user_warning, POP, reference_indices, reset_substitute_expression_in_expression(), macro_t::rhs, substitute_expression_in_expression(), syntax_call, syntax_reference, syntax_undefined, and untrusted_call_p().

Referenced by parser_substitute_all_macros().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ parser_reset_all_reader_buffers()

void parser_reset_all_reader_buffers ( void )

Definition at line 313 of file reader.c.

 {
     iLine = 0, lLine = 0;
     iStmt = 0, lStmt = 0;
     iCurrComm = 0;
     iComm = 0;
     iPrevComm = 0;
     i_getchar = UNDEF, l_getchar = UNDEF;
     EofSeen = false;
 }

References EofSeen, i_getchar, iComm, iCurrComm, iLine, iPrevComm, iStmt, l_getchar, lLine, lStmt, and UNDEF.

Referenced by ParserError().

Here is the caller graph for this function:

◆ parser_reset_StmtHeap_buffer()

void parser_reset_StmtHeap_buffer ( void )

statement.c

Definition at line 85 of file statement.c.

 {
     CurrentStmt = 0;
 }

References CurrentStmt.

Referenced by ParserError().

Here is the caller graph for this function:

◆ parser_substitute_all_macros()

void parser_substitute_all_macros ( statement s )

Definition at line 294 of file macros.c.

 {
     if (current_macro_index>0 &&
         get_bool_property("PARSER_EXPAND_STATEMENT_FUNCTIONS"))
         gen_recurse(s, expression_domain, gen_true, parser_macro_expansion);
 }

References current_macro_index, expression_domain, gen_recurse, gen_true(), get_bool_property(), and parser_macro_expansion().

Referenced by EndOfProcedure(), and parser_substitute_all_macros_in_expression().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ parser_substitute_all_macros_in_expression()

void parser_substitute_all_macros_in_expression ( expression e )

Definition at line 302 of file macros.c.

 {
   parser_substitute_all_macros((statement)e);
 }

References parser_substitute_all_macros().

Referenced by parser_add_a_macro().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ParserError()

bool ParserError	(	const char *	f,
		const char *	m
	)

Maybe a routine called by ParserError() may call ParserError() e.g. AbortOfProcedure() thru remove_ghost_variables()

Get rid of partly declared variables...

Callers may already have pointers towards this function. The prettyprinter core dumps if entity_initial is destroyed. Maybe, I should clean the declarations field in code, as well as decls_text.

The error may occur before the current module entity is defined

GetChar() will reinitialize its own buffer when called

Because of the strange behavior of BeginingOfParsing

CurrentPackage = NULL;

Too bad for memory leak...

FI: let catch_error() take care of this in pipsmake since debug_on() was not activated in ParserError

debug_off();

Should never be executed

Definition at line 116 of file parser.c.

 {
     entity mod = get_current_module_entity();
  
     /* Maybe a routine called by ParserError() may call ParserError()
      * e.g. AbortOfProcedure() thru remove_ghost_variables()
      */
     if(InParserError)
         return false;
  
     InParserError = true;
  
     uses_alternate_return(false);
     ResetReturnCodeVariable();
     SubstituteAlternateReturns("NO");
  
     syn_reset_lex();
  
     ResetBlockStack();
  
     /* Get rid of partly declared variables... */
     if(mod!=entity_undefined) {
         /* Callers may already have pointers towards this function.
          * The prettyprinter core dumps if entity_initial is
          * destroyed. Maybe, I should clean the declarations field
          * in code, as well as decls_text.
          */
         /*
         entity_type(mod) = type_undefined;
         entity_storage(mod) = storage_undefined;
         entity_initial(mod) = value_undefined;
         */
         value v = entity_initial(mod);
         code c = value_code(v);
         code_declarations(c) = NIL;
         code_decls_text(c) = string_undefined;
  
         CleanLocalEntities(mod);
     }
  
     /* The error may occur before the current module entity is defined */
     error_reset_current_module_entity();
     safe_fclose(syn_in, CurrentFN);
     free(CurrentFN);
     CurrentFN = NULL;
  
     /* GetChar() will reinitialize its own buffer when called */
  
     /* Because of the strange behavior of BeginingOfParsing*/
     /* CurrentPackage = NULL; */
     CurrentPackage = TOP_LEVEL_MODULE_NAME;
     /* Too bad for memory leak... */
     DynamicArea = entity_undefined;
     StaticArea = entity_undefined;
     HeapArea = entity_undefined;
     reset_common_size_map_on_error();
     parser_reset_all_reader_buffers();
     parser_reset_StmtHeap_buffer();
     reset_parser_recursive_call();
     soft_reset_alternate_returns();
     ResetChains();
     AbortEntries();
     AbortOfProcedure();
  
     InParserError = false;
  
     /* FI: let catch_error() take care of this in pipsmake since debug_on()
        was not activated in ParserError */
     /* debug_off(); */
     user_error(f,"Parser error between lines %d and %d\n%s\n",
                line_b_I,line_e_I,m);
  
     /* Should never be executed */
     return true;
 }

References AbortEntries(), AbortOfProcedure(), CleanLocalEntities(), code_declarations, code_decls_text, CurrentFN, CurrentPackage, DynamicArea, entity_initial, entity_undefined, error_reset_current_module_entity(), f(), free(), get_current_module_entity(), HeapArea, InParserError, line_b_I, line_e_I, NIL, parser_reset_all_reader_buffers(), parser_reset_StmtHeap_buffer(), reset_common_size_map_on_error(), reset_parser_recursive_call(), ResetBlockStack(), ResetChains(), ResetReturnCodeVariable(), safe_fclose(), soft_reset_alternate_returns(), StaticArea, string_undefined, SubstituteAlternateReturns(), syn_in, syn_reset_lex(), TOP_LEVEL_MODULE_NAME, user_error, uses_alternate_return(), and value_code.

Referenced by AddVariableToCommon(), AnalyzeData(), CapitalizeStmt(), check_in_declarations(), CheckAndInitializeStmt(), CheckParenthesis(), ComputeAddresses(), DeclareExternalFunction(), DeclarePointer(), DeclareVariable(), EndOfProcedure(), EvalCall(), EvalSyntax(), expression_reference_number(), find_target_position(), fix_if_condition(), fix_storage(), FortranExpressionList(), IsCapKeyword(), LinkInstToCurrentBlock(), make_Fortran_constant_entity(), MakeAssignInst(), MakeAtom(), MakeCurrentFunction(), MakeDataValueSet(), MakeElseInst(), MakeEnddoInst(), MakeEndifInst(), MakeEntryCommon(), MakeEquivAtom(), MakeFormalParameter(), MakeFortranBinaryCall(), MakeFortranType(), MakeFortranUnaryCall(), MakeParameter(), MakeSimpleIoInst1(), MakeSimpleIoInst2(), MakeStatement(), MakeVariableStatic(), NeedKeyword(), NewStmt(), parser_add_a_macro(), PopBlock(), process_static_initialization(), process_value_list(), PushBlock(), ReadLine(), ReadStmt(), remove_ghost_variable_entities(), reset_common_size_map(), SafeSizeOfArray(), SaveChains(), SaveEntity(), store_initial_value(), SubstituteAlternateReturns(), TypeFunctionalEntity(), update_called_modules(), update_functional_type_result(), uses_alternate_return(), and ValueOfIthLowerBound().

Here is the call graph for this function:

◆ PipsGetc()

int PipsGetc ( FILE * fp )

Routine de lecture pour l'analyseur lexical, lex ou flex.

Parameters

fp p

Definition at line 557 of file reader.c.

 {
     int eof = false;
     int c;
  
     if (iStmt == SIZE_UNDEF || iStmt >= lStmt) {
         /*
          * le statement est vide. On lit et traite le suivant.
          */
         if (ReadStmt(fp) == EOF) {
             eof = true;
         }
         else {
             /*
              * verifie les parentheses et on recherche les '=' et
              * les ',' de profondeur zero.
              */
             CheckParenthesis();
  
             /*
              * on recherche les operateurs du genre .eq.
              */
             FindPoints();
  
             if (!FindDo()) {
                 if (!FindImplicit()) {
                     if (!FindIfArith()) {
                         FindIf();
                                                 
                         if (!FindAssign()) {
                             FindAutre();
                         }
                     }
                 }
             }
  
             iStmt = 0;
         }
     }
  
     c = stmt_buffer[iStmt++];
     return((eof) ? EOF : UNQUOTE(c));
 }

References CheckParenthesis(), FindAssign(), FindAutre(), FindDo(), FindIf(), FindIfArith(), FindImplicit(), FindPoints(), iStmt, lStmt, ReadStmt(), SIZE_UNDEF, stmt_buffer, and UNQUOTE.

Here is the call graph for this function:

◆ PopBlock()

instruction PopBlock ( void )

Definition at line 238 of file statement.c.

 {
   if (IsBlockStackEmpty())
     ParserError("PopBlock", "bottom of stack reached\n");
  
   return(BlockStack[--CurrentBlock].i);
 }

References BlockStack, CurrentBlock, IsBlockStackEmpty(), and ParserError().

Referenced by EndOfProcedure(), LinkInstToCurrentBlock(), MakeElseInst(), MakeEnddoInst(), and MakeEndifInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ print_full_malloc_info()

void print_full_malloc_info ( FILE * )

◆ print_malloc_info()

void print_malloc_info ( FILE * )

malloc-info.c

◆ PrintChain()

void PrintChain ( chain c )

Definition at line 382 of file equivalence.c.

 {
     cons *pca;
     atom a;
  
     ifdebug(9) {
         pips_debug(9, "Begin: ");
  
         for (pca = chain_atoms(c); pca != NIL; pca = CDR(pca)) {
             a = ATOM(CAR(pca));
  
             (void) fprintf(stderr, "(%s,%td) ; ",
                            entity_name(atom_equivar(a)), atom_equioff(a));
         }
         (void) fprintf(stderr, "\n");
         pips_debug(9, "End\n");
     }
 }

References ATOM, atom_equioff, atom_equivar, CAR, CDR, chain_atoms, entity_name, fprintf(), ifdebug, NIL, and pips_debug.

Referenced by PrintChains().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ PrintChains()

void PrintChains ( equivalences e )

two debugging functions, just in case ...

Definition at line 364 of file equivalence.c.

 {
     cons *pcc;
  
     if(ENDP(equivalences_chains(e))) {
         ifdebug(9) {
             (void) fprintf(stderr, "Empty list of equivalence chains\n");
         }
     }
     else {
         for (pcc = equivalences_chains(e); pcc != NIL; pcc = CDR(pcc)) {
             PrintChain(CHAIN(CAR(pcc)));
         }
     }
 }

References CAR, CDR, CHAIN, ENDP, equivalences_chains, fprintf(), ifdebug, NIL, and PrintChain().

Referenced by ComputeEquivalences().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ PrintData()

void PrintData	(	cons *	ldvr,
		cons *	ldvl
	)

a debugging function, just in case ...

Parameters

ldvr	dvr
ldvl	dvl

Definition at line 310 of file declaration.c.

 {
     cons *pc;
  
     debug(7, "PrintData", "Begin\n");
  
     for (pc = ldvr; pc != NIL; pc = CDR(pc)) {
         datavar dvr = DATAVAR(CAR(pc));
  
         debug(7, "PrintData", "(%s,%d), ", entity_name(datavar_variable(dvr)),
               datavar_nbelements(dvr));
  
     }
     debug(7, "PrintData", "\n");
  
     for (pc = ldvl; pc != NIL; pc = CDR(pc)) {
         dataval dvl = DATAVAL(CAR(pc));
  
         if (constant_int_p(dataval_constant(dvl))) {
             debug(7, "PrintData", "(%d,%d), ", constant_int(dataval_constant(dvl)),
                   dataval_nboccurrences(dvl));
         }
         else {
             debug(7, "PrintData", "(x,%d), ", dataval_nboccurrences(dvl));
         }
  
     }
     debug(7, "PrintData", "End\n\n");
 }

References CAR, CDR, constant_int, constant_int_p, DATAVAL, dataval_constant, dataval_nboccurrences, DATAVAR, datavar_nbelements, datavar_variable, debug(), entity_name, and NIL.

Here is the call graph for this function:

◆ ProcessEntries()

void ProcessEntries ( void )

To avoid an include of the prettyprint library and/or a compiler warning.

The declarations for cm are likely to be incorrect. They must be synthesized by the prettyprinter.

Regenerate a SOURCE_FILE .f without entries for the module itself

To avoid warnings about column 73 when the code is parsed again

Not ot duplicate DATA statements for static variables and common variables in every entry

Process each entry

Postponed to the_actual_parser() which needs to know entries were encountered

ResetEntries();

Definition at line 2171 of file procedure.c.

 {
     entity cm = get_current_module_entity();
     code c = entity_code(cm);
     list ce = NIL;
     list cl = NIL;
     list ct = NIL;
     text txt = text_undefined;
     bool line_numbering_p = get_bool_property("PRETTYPRINT_STATEMENT_NUMBER");
     bool data_statements_p = get_bool_property("PRETTYPRINT_DATA_STATEMENTS");
     /* To avoid an include of the prettyprint library and/or a
        compiler warning. */
     /* The declarations for cm are likely to be incorrect. They must be
      * synthesized by the prettyprinter.
      */
     free(code_decls_text(c));
     code_decls_text(c) = strdup("");
     /* Regenerate a SOURCE_FILE .f without entries for the module itself */
     /* To avoid warnings about column 73 when the code is parsed again */
     set_bool_property("PRETTYPRINT_STATEMENT_NUMBER", false);
     txt = text_named_module(cm, cm, get_current_module_statement());
     make_text_resource_and_free(module_local_name(cm), DBR_SOURCE_FILE, ".f",
                                 txt);
  
     /* Not ot duplicate DATA statements for static variables and
        common variables in every entry */
     set_bool_property("PRETTYPRINT_DATA_STATEMENTS", false);
  
     /* Process each entry */
     for(ce = entry_entities, cl = entry_labels, ct = entry_targets;
         !ENDP(ce) && !ENDP(cl) && !ENDP(ct); POP(ce), POP(cl), POP(ct)) {
         entity e = ENTITY(CAR(ce));
         entity l = ENTITY(CAR(cl));
         statement t = STATEMENT(CAR(ct));
  
         pips_assert("Target and label match", l==statement_label(t));
  
         ProcessEntry(cm, e, t);
     }
     set_bool_property("PRETTYPRINT_STATEMENT_NUMBER", line_numbering_p);
     set_bool_property("PRETTYPRINT_DATA_STATEMENTS", data_statements_p);
     /* Postponed to the_actual_parser() which needs to know entries were
        encountered */
     /* ResetEntries(); */
 }

References CAR, code_decls_text, ENDP, ENTITY, entity_code(), entry_entities, entry_labels, entry_targets, free(), get_bool_property(), get_current_module_entity(), get_current_module_statement(), make_text_resource_and_free(), module_local_name(), NIL, pips_assert, POP, ProcessEntry(), set_bool_property(), STATEMENT, statement_label, strdup(), text_named_module(), and text_undefined.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ProcessSave()

void ProcessSave ( entity v )

Definition at line 282 of file declaration.c.

 {
   MakeVariableStatic(v, true);
 }

References MakeVariableStatic().

Here is the call graph for this function:

◆ PushBlock()

void PushBlock	(	instruction	i,
		string	l
	)

Definition at line 221 of file statement.c.

 {
   if (IsBlockStackFull())
     ParserError("PushBlock", "top of stack reached\n");
  
   pips_assert("PushBlock", instruction_block_p(i));
  
   BlockStack[CurrentBlock].i = i;
   BlockStack[CurrentBlock].l = l;
   BlockStack[CurrentBlock].c = NULL;
   BlockStack[CurrentBlock].elsifs = 0;
   CurrentBlock += 1;
 }

References BlockStack, CurrentBlock, instruction_block_p, IsBlockStackFull(), ParserError(), and pips_assert.

Referenced by MakeBlockIfInst(), MakeCurrentFunction(), MakeDoInst(), MakeElseInst(), and MakeWhileDoInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ReadLine()

int ReadLine ( FILE * fp )

All physical lines of a statement are put together in a unique buffer called "line_buffer".

Each character in each physical line is retrieved with GetChar().

on entre dans ReadLine avec Column = 1

Read all comment lines you can

Read label

Check continuation character

Keep track of the first and last comment lines and of the first and last statement lines. These two intervals may intersect.

Append current comment CurrComm to Comm if it is a continuation. Save Comm in PrevComm and CurrComm in Comm if it is a first statement line.

FI: this is all wrong

Why destroy comments because there are continuation lines?

tmp_b_C = tmp_e_C = UNDEF;

Read the rest of the line, skipping SPACEs but handling string constants

Parameters

fp p

Definition at line 765 of file reader.c.

 {
     static char QuoteChar = '\000';
     int TypeOfLine;
     int i, c;
     char label[6];
     int ilabel = 0;
  
     /* on entre dans ReadLine avec Column = 1 */
     pips_assert("ReadLine", Column == 1);
  
     init_line_buffer();
  
     /* Read all comment lines you can */
     while (strchr(START_COMMENT_LINE,(c = GetChar(fp))) != NULL) {
         if (tmp_b_C == UNDEF)
             tmp_b_C = (c=='\n')?LineNumber-1:LineNumber;
  
         ifdebug(8) {
             if(c=='\n')
                 debug(8, "ReadLine",
                       "Empty comment line detected at line %d "
                       "for comment starting at line %d\n",
                       LineNumber-1, tmp_b_C);
         }
  
         while(c!=EOF) {
             if (iCurrComm >= CommSize-2)
                 resize_comment_buffers();
             CurrComm[iCurrComm++] = c;
             if(c=='\n') break;
             c = GetChar(fp);
         }
     }
  
     CurrComm[iCurrComm] = '\0';
  
     pips_debug(7, "comment CurrComm: (%d) --%s--\n", iCurrComm, CurrComm);
  
     if (c != EOF) {
         /* Read label */
         for (i = 0; i < 5; i++) {
             if (c != ' ') {
                 if (isdigit(c)) {
                     label[ilabel++] = c;
                 }
                 else {
                     pips_user_warning("Unexpected character '%c' (0x%x)\n", 
                                  c, (int) c);
                     ParserError("ReadLine",
                                 "non numeric character in label!\n");
                 }
             }
             c = GetChar(fp);
         }
  
         if (ilabel > 0) {
             label[ilabel] = '\0';
             strcpy(tmp_lab_I, label);
         }
         else
             strcpy(tmp_lab_I, "");
  
         /* Check continuation character */
         TypeOfLine = (c != ' ' && c!= '0') ? CONTINUATION_LINE : FIRST_LINE;
  
         /* Keep track of the first and last comment lines and of the first and
          * last statement lines. These two intervals may intersect.
          *
          * Append current comment CurrComm to Comm if it is a continuation. Save Comm
          * in PrevComm and CurrComm in Comm if it is a first statement line.
          */
         if (TypeOfLine == FIRST_LINE) {
             if(iComm!=0) {
                 Comm[iComm] = '\0';
                 (void) strcpy(PrevComm, Comm);
                 Comm[0] = '\0';
             }
             else {
                 PrevComm[0] = '\0';
             }
             iPrevComm = iComm;
  
             (void) strcpy(Comm, CurrComm);
             iComm = iCurrComm;
             iCurrComm = 0;
             CurrComm[0] = '\0';
  
             if (tmp_b_C != UNDEF)
                 tmp_e_C = LineNumber - 1;
             tmp_b_I = LineNumber;
         }
         else if (TypeOfLine == CONTINUATION_LINE){
             if (iCurrComm+iComm >= CommSize-2)
                 resize_comment_buffers();
             (void) strcat(Comm, CurrComm);
             iComm += iCurrComm;
             iCurrComm = 0;
             CurrComm[0] = '\0';
  
             /* FI: this is all wrong */
             /* Why destroy comments because there are continuation lines? */
             /* tmp_b_C = tmp_e_C = UNDEF; */
         }
  
         pips_debug(7, "comment Comm: (%d) --%s--\n", iComm, Comm);
         pips_debug(7, "comment PrevComm: (%d) --%s--\n", iPrevComm, PrevComm);
  
         /* Read the rest of the line, skipping SPACEs but handling string constants */
  
         while ((c = GetChar(fp)) != '\n') {
             if (c == '\'' || c == '"') {
                 if (EtatQuotes == INQUOTES) {
                     if(c == QuoteChar)
                         EtatQuotes = INQUOTEQUOTE;
                     else {
                         if (EtatQuotes == INQUOTEQUOTE)
                             EtatQuotes = NONINQUOTES;
                     }
                 }
                 else if(EtatQuotes == INQUOTEBACKSLASH) 
                     EtatQuotes = INQUOTES;
                 else {
                     EtatQuotes = INQUOTES;
                     QuoteChar = c;
                 }
             }
             else {
                 if (EtatQuotes == INQUOTEQUOTE)
                     EtatQuotes = NONINQUOTES;
                 else if(EtatQuotes == INQUOTES && c == '\\')
                     EtatQuotes = INQUOTEBACKSLASH;
                 else if(EtatQuotes == INQUOTEBACKSLASH)
                     EtatQuotes = INQUOTES;
             }
  
             if (lLine>line_buffer_size-5)
                 resize_line_buffer();
  
             if (EtatQuotes == NONINQUOTES) {
                 if (c != ' ') {
                     line_buffer[lLine++] = islower(c)? toupper(c) : c;
                 }
             }
             else {
                 line_buffer[lLine++] = QUOTE(c);
             }
                                 
         }
  
         if (EtatQuotes == INQUOTEQUOTE)
             EtatQuotes = NONINQUOTES;
     }
     else {
         TypeOfLine = EOF_LINE;
         if (tmp_b_C != UNDEF)
             tmp_e_C = LineNumber - 1;
         tmp_b_I = LineNumber;
  
         if(iComm!=0) {
             Comm[iComm] = '\0';
             (void) strcpy(PrevComm, Comm);
             Comm[0] = '\0';
         }
         else {
             PrevComm[0] = '\0';
         }
         iPrevComm = iComm;
     }
  
     pips_debug(9, "Aggregation of continuation lines: '%s'\n", (char*)line_buffer);
  
     return(TypeOfLine);
 }

References Column, Comm, CommSize, CONTINUATION_LINE, CurrComm, debug(), EOF_LINE, EtatQuotes, FIRST_LINE, GetChar(), iComm, iCurrComm, ifdebug, init_line_buffer(), INQUOTEBACKSLASH, INQUOTEQUOTE, INQUOTES, iPrevComm, line_buffer, line_buffer_size, LineNumber, lLine, NONINQUOTES, ParserError(), pips_assert, pips_debug, pips_user_warning, PrevComm, QUOTE, resize_comment_buffers(), resize_line_buffer(), START_COMMENT_LINE, tmp_b_C, tmp_b_I, tmp_e_C, tmp_lab_I, and UNDEF.

Referenced by ReadStmt().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ReadStmt()

int ReadStmt ( FILE * fp )

regroupement des lignes du statement en une unique ligne sans continuation

It would be nice to move the current comments from Comm to PrevComm, but it is just too late because of the repeat until control structure down: ReadLine() has already been called and read the first line of the next statement. Hence, CurrComm is needed.

Memorize the line number before to find next Statement

Update the current final lines for instruction and comments

Initialize temporary beginning and end line numbers

Parameters

fp p

Definition at line 942 of file reader.c.

 {
     int TypeOfLine;     
     int result;
  
     init_stmt_buffer();
  
     if (EofSeen == true) {
         /*
          * on a rencontre EOF, et on a deja purge le dernier
          * statement. On arrete.
          */
         EofSeen = false;
         result = EOF;
     }
     else {
         /*
          * on a deja lu la 1ere ligne sauf au moment de l'initialisation
          */
         if (lLine == UNDEF) {
             lLine = 0;
  
             tmp_b_I = tmp_e_I = UNDEF;
             tmp_b_C = tmp_e_C = UNDEF;
  
             if ((TypeOfLine = ReadLine(fp)) == CONTINUATION_LINE) {
                 ParserError("ReadStmt",
                   "[scanner] incorrect continuation line as first line\n");
             }
             else if (TypeOfLine == FIRST_LINE) {
                 /* It would be nice to move the current comments from
                  * Comm to PrevComm, but it is just too late because of
                  * the repeat until control structure down: ReadLine()
                  * has already been called and read the first line of
                  * the next statement. Hence, CurrComm is needed.
                  */
             }
             else if (TypeOfLine == EOF_LINE) {
                 result = EOF;
             }
         }
  
         line_b_I = tmp_b_I;
         line_b_C = tmp_b_C;
         strcpy(lab_I, tmp_lab_I);
                 
         lStmt = 0;
         /* Memorize the line number before to find next Statement*/
         StmtLineNumber = LineNumber;
         do {
             iLine = 0;
             while (iLine < lLine) {
                 if (lStmt>stmt_buffer_size-20)
                     resize_stmt_buffer();
                 stmt_buffer[lStmt++] = line_buffer[iLine++];
             }
             lLine = 0;
  
             /* Update the current final lines for instruction and comments */
             line_e_I = tmp_e_I;
             line_e_C = tmp_e_C;
  
             /* Initialize temporary beginning and end line numbers */
              tmp_b_I = tmp_e_I = UNDEF;
              tmp_b_C = tmp_e_C = UNDEF;
  
         } while ((TypeOfLine = ReadLine(fp)) == CONTINUATION_LINE) ;
  
         stmt_buffer[lStmt++] = '\n';
         iStmt = 0;
  
         line_e_I = (tmp_b_C == UNDEF) ? tmp_b_I-1 : tmp_b_C-1;
                 
         if (TypeOfLine == EOF_LINE)
             EofSeen = true;
  
         result = 1;
  
         ifdebug(7) {
           size_t i;
           pips_debug(7, "stmt: (%td)\n", lStmt);
           for(i=0; i<lStmt; i++)
             putc((int) stmt_buffer[i], stderr);
         }
     }
  
     return(result);
 }

References CONTINUATION_LINE, EOF_LINE, EofSeen, FIRST_LINE, ifdebug, iLine, init_stmt_buffer(), iStmt, lab_I, line_b_C, line_b_I, line_buffer, line_e_C, line_e_I, LineNumber, lLine, lStmt, ParserError(), pips_debug, ReadLine(), resize_stmt_buffer(), stmt_buffer, stmt_buffer_size, StmtLineNumber, tmp_b_C, tmp_b_I, tmp_e_C, tmp_e_I, tmp_lab_I, and UNDEF.

Referenced by PipsGetc().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ reify_ghost_variable_entity()

void reify_ghost_variable_entity ( entity e )

It is possible to change one's mind and effectively use an entity which was previously assumed useless.

Definition at line 284 of file procedure.c.

 {
     pips_assert("defined list", !list_undefined_p(ghost_variable_entities));
     if(entity_is_argument_p(e, ghost_variable_entities))
         ghost_variable_entities = arguments_rm_entity(ghost_variable_entities, e);
 }

References arguments_rm_entity(), entity_is_argument_p(), ghost_variable_entities, list_undefined_p, and pips_assert.

Referenced by CheckLeftHandSide().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ remove_from_called_modules()

void remove_from_called_modules ( entity e )

macros are added, although they should not have been.

Definition at line 354 of file procedure.c.

 {
     bool found = false;
     list l = called_modules;
     const char* name = module_local_name(e);
  
     if (!called_modules) return;
  
     if (same_string_p(name, STRING(CAR(called_modules)))) {
         called_modules = CDR(called_modules);
         found = true;
     } else {
         list lp = called_modules;
         l = CDR(called_modules);
         
         for(; !ENDP(l); POP(l), POP(lp)) {
             if (same_string_p(name, STRING(CAR(l)))) {
                 CDR(lp) = CDR(l);
                 found = true;
                 break;
             }
         }
     }
  
     if (found) {
         pips_debug(3, "removing %s from callees\n", entity_name(e));
         CDR(l) = NIL;
         free(STRING(CAR(l)));
         gen_free_list(l);
     }
 }

References called_modules, CAR, CDR, ENDP, entity_name, free(), gen_free_list(), module_local_name(), NIL, pips_debug, POP, same_string_p, and STRING.

Referenced by parser_close_macros_support().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ remove_ghost_variable_entities()

void remove_ghost_variable_entities ( bool substitute_p )

The debugging message must use the variable name before it is freed

We already are in ParserError()! Too bad for the memory leak

Parameters

substitute_p ubstitute_p

Definition at line 206 of file procedure.c.

 {
     pips_assert("defined list", !list_undefined_p(ghost_variable_entities));
     MAP(ENTITY, e,
     {
         /* The debugging message must use the variable name before it is freed
          */
         pips_debug(1, "entity '%s'\n", entity_name(e));
         pips_assert("Entity e is defined and has type \"variable\" if substitution is required\n",
                     !substitute_p
                     || (!entity_undefined_p(e)
                         && (type_undefined_p(entity_type(e)) || type_variable_p(entity_type(e)))));
         if(entity_in_equivalence_chains_p(e)) {
             user_warning("remove_ghost_variable_entities",
                      "Entity \"%s\" does not really exist but appears"
                      " in an equivalence chain!\n",
                      entity_name(e));
             if(!ParserError("remove_ghost_variable_entities",
                             "Cannot remove still accessible ghost variable\n")) {
                 /* We already are in ParserError()! Too bad for the memory leak */
                 ghost_variable_entities = list_undefined;
                 return;
             }
         }
         else {
             entity fe = local_name_to_top_level_entity(entity_local_name(e));
  
             if(entity_undefined_p(fe)) {
                 pips_assert("Entity fe cannot be undefined", false);
             }
             else if(type_undefined_p(entity_type(fe))) {
                 pips_assert("Type for entity fe cannot be undefined", false);
             }
             else if(type_functional_p(entity_type(fe))) {
                 statement stmt = function_body;
  
  
                 /*
                 if(intrinsic_entity_p(fe)) {
                     user_warning("remove_ghost_variable_entities",
                                  "Intrinsic %s is probably declared in a strange useless way\n",
                                  module_local_name(fe));
                 }
                 */
  
  
                 if(substitute_p) {
                     pips_debug(1,
                           "Start substitution of variable %s by module %s\n",
                           entity_name(e), entity_name(fe));
                     substitute_ghost_variable_in_statement(stmt, e, fe);
                     pips_debug(1,
                           "End for substitution of variable %s by module %s\n",
                           entity_name(e), entity_name(fe));
                 }
             }
             else {
                 pips_assert("Type t for entity fe should be functional", false);
             }
  
             remove_variable_entity(e);
         }
         pips_debug(1, "destroyed\n");
     },
         ghost_variable_entities);
  
     ghost_variable_entities = list_undefined;
 }

References ENTITY, entity_in_equivalence_chains_p(), entity_local_name(), entity_name, entity_type, entity_undefined_p, function_body, ghost_variable_entities, list_undefined, list_undefined_p, local_name_to_top_level_entity(), MAP, ParserError(), pips_assert, pips_debug, remove_variable_entity(), substitute_ghost_variable_in_statement(), type_functional_p, type_undefined_p, type_variable_p, and user_warning.

Referenced by AbortOfProcedure(), and EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ remove_module_entity()

void remove_module_entity ( entity m )

It is assumed that neither variables nor areas have been declared in m but that m may have been declared by EXTERNAL in other modules.

Definition at line 1188 of file procedure.c.

 {
     /* It is assumed that neither variables nor areas have been declared in m
      * but that m may have been declared by EXTERNAL in other modules.
      */
     gen_array_t modules = db_get_module_list();
     int module_list_length = gen_array_nitems(modules);
     int i = 0;
  
     for(i = 0; i < module_list_length; i++) {
         entity om = local_name_to_top_level_entity(gen_array_item(modules, i));
  
         if(!entity_undefined_p(om)) {
             value v = entity_initial(om);
  
             if(!value_undefined_p(v) && !value_unknown_p(v)) {
                 code c = value_code(v);
  
                 if(!code_undefined_p(c)) {
                     ifdebug(1) {
                         if(gen_in_list_p(m, code_declarations(c))) {
                             pips_debug(1,
                                   "Declaration of module %s removed from %s's declarations",
                                   entity_name(m), entity_name(om));
                         }
                     }
                     gen_remove(&code_declarations(c), m);
                 }
             }
         }
     }
     gen_array_full_free(modules);
     free_entity(m);
 }

References code_declarations, code_undefined_p, db_get_module_list(), entity_initial, entity_name, entity_undefined_p, free_entity(), gen_array_full_free(), gen_array_item(), gen_array_nitems(), gen_in_list_p(), gen_remove(), ifdebug, local_name_to_top_level_entity(), pips_debug, value_code, value_undefined_p, and value_unknown_p.

Referenced by MakeCurrentFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ reset_alternate_returns()

void reset_alternate_returns ( void )

Definition at line 272 of file return.c.

 {
     pips_assert("alternate return list is defined", !list_undefined_p(alternate_returns));
     gen_free_list(alternate_returns);
     alternate_returns = list_undefined;
     current_number_of_alternate_returns = -1;
 }

References alternate_returns, current_number_of_alternate_returns, gen_free_list(), list_undefined, list_undefined_p, and pips_assert.

Referenced by soft_reset_alternate_returns().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ reset_common_size_map()

void reset_common_size_map ( void )

Problems:

this routine may be called from ParserError()... which should not be called recursively
but it maight also be called from somewhere else and ParserError() then should be called A second reset routine must be defined.

Definition at line 954 of file declaration.c.

 {
    if (common_size_map != hash_table_undefined) {
       hash_table_free(common_size_map);
       common_size_map = hash_table_undefined;
    }
    else {
        /* Problems:
         *  - this routine may be called from ParserError()... which should not
         *    be called recursively
         *  - but it maight also be called from somewhere else and ParserError()
         *    then should be called
         * A second reset routine must be defined.
         */
        ParserError("reset_common_size_map", "Resetting a resetted variable!\n");
    }
 }

References common_size_map, hash_table_free(), hash_table_undefined, and ParserError().

Referenced by EndOfProcedure(), and gfc2pips_namespace().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ reset_common_size_map_on_error()

void reset_common_size_map_on_error ( void )

Definition at line 972 of file declaration.c.

 {
    if (common_size_map != hash_table_undefined) {
       hash_table_free(common_size_map);
       common_size_map = hash_table_undefined;
    }
 }

References common_size_map, hash_table_free(), and hash_table_undefined.

Referenced by ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ reset_current_label_string()

void reset_current_label_string ( void )

Definition at line 71 of file parser.c.

 {
     strcpy(lab_I, "");
 }

References lab_I.

Referenced by LinkInstToCurrentBlock(), and MakeElseInst().

Here is the caller graph for this function:

◆ reset_current_number_of_alternate_returns()

void reset_current_number_of_alternate_returns ( void )

Definition at line 192 of file return.c.

 {
   current_number_of_alternate_returns = -1;
 }

References current_number_of_alternate_returns.

◆ reset_first_statement()

void reset_first_statement ( void )

Definition at line 1944 of file statement.c.

 {
     seen = false;
     format_seen = false;
     declaration_lines = -1;
 }

References declaration_lines, format_seen, and seen.

◆ reset_substitute_expression_in_expression()

void reset_substitute_expression_in_expression ( void )

Definition at line 218 of file macros.c.

 {
     gen_free_list(already_subs); 
     already_subs = NIL;
 }

References already_subs, gen_free_list(), and NIL.

Referenced by parser_macro_expansion().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ResetBlockStack()

void ResetBlockStack ( void )

Definition at line 203 of file statement.c.

 {
   CurrentBlock = 0;
 }

References CurrentBlock.

Referenced by AbortOfProcedure(), and ParserError().

Here is the caller graph for this function:

◆ ResetChains()

void ResetChains ( void )

undefine chains between two successives calls to parser

Definition at line 65 of file equivalence.c.

 {
     free_equivalences(TempoEquivSet);
     free_equivalences(FinalEquivSet);
     TempoEquivSet = equivalences_undefined;
     FinalEquivSet = equivalences_undefined;
 }

References equivalences_undefined, FinalEquivSet, free_equivalences(), and TempoEquivSet.

Referenced by EndOfProcedure(), gfc2pips_namespace(), and ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ResetEntries()

void ResetEntries ( void )

Definition at line 1458 of file procedure.c.

 {
     gen_free_list(entry_labels);
     entry_labels = NIL;
  
     gen_free_list(entry_targets);
     entry_targets = NIL;
  
     gen_free_list(entry_entities);
     entry_entities = NIL;
  
     gen_free_list(effective_formal_parameters);
     effective_formal_parameters = NIL;
 }

References effective_formal_parameters, entry_entities, entry_labels, entry_targets, gen_free_list(), and NIL.

Referenced by the_actual_parser().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ResetReturnCodeVariable()

void ResetReturnCodeVariable ( void )

Definition at line 151 of file return.c.

 {
     return_code_variable = entity_undefined;
 }

References entity_undefined, and return_code_variable.

Referenced by EndOfProcedure(), and ParserError().

Here is the caller graph for this function:

◆ ReturnCodeVariableP()

bool ReturnCodeVariableP ( entity rcv )

Parameters

rcv cv

Definition at line 145 of file return.c.

 {
     return rcv == return_code_variable;
 }

References return_code_variable.

Referenced by MakeFormalParameter().

Here is the caller graph for this function:

◆ retype_formal_parameters()

void retype_formal_parameters ( void )

If an IMPLICIT statement is encountered, it must be applied to the formal parameters, and, if the current module is a function, to the function result type and to the variable used internally when a value is assigned to the function (see MakeCurrentFunction)

If the current module is a function, its type should be updated.

The function signature is computed later by UpdateFunctionalType() called from EndOfProcedure: there should be no parameters in the type.

Update type of internal variable used to store the function result

nothing to be done: subroutine or main

Definition at line 1411 of file declaration.c.

 {
     entity m = get_current_module_entity();
     list vars = code_declarations(value_code(entity_initial(m)));
     type tm = entity_type(m);
     type tr = type_undefined;
  
     pips_debug(8, "Begin for module %s\n",
           module_local_name(m));
  
     MAP(ENTITY, v, {
         if(!storage_undefined_p(entity_storage(v)) && formal_parameter_p(v)) {
             if(!implicit_type_p(v)) {
                 free_type(entity_type(v));
                 entity_type(v) = ImplicitType(v);
  
                 pips_debug(8, "Retype formal parameter %s\n",
                       entity_local_name(v));
             }
         }
         else if(storage_undefined_p(entity_storage(v))
                 || (storage_ram_p(entity_storage(v)) && variable_entity_p(v))
                 || (storage_rom_p(entity_storage(v)) && entity_function_p(v))) 
         {
             pips_debug(8, "Cannot retype entity %s: warning!!!\n",
                        entity_local_name(v));
                 pips_user_warning("Cannot retype variable or function %s."
                              " Move up the implicit statement at the beginning of declarations.\n",
                              entity_local_name(v));
         }
         else {
             pips_debug(8, "Ignore entity %s\n",
                   entity_local_name(v));
         }
     }, vars);
  
     /* If the current module is a function, its type should be updated. */
  
     pips_assert("Should be a functional type", type_functional_p(tm));
  
     /* The function signature is computed later by  UpdateFunctionalType()
      * called from EndOfProcedure: there should be no parameters in the type.
      */
     pips_assert("Parameter type list should be empty",
                 ENDP(functional_parameters(type_functional(tm))));
  
     tr = functional_result(type_functional(tm));
     if(type_variable_p(tr)) {
         if(!implicit_type_p(m)) {
             entity r = entity_undefined;
             free_type(tr);
             functional_result(type_functional(tm)) = ImplicitType(m);
             pips_debug(8, "Retype result of function %s\n",
                        module_local_name(m));
  
             /* Update type of internal variable used to store the function result */
             if((r=FindEntity(module_local_name(m), module_local_name(m)))
                != entity_undefined) {
                 free_type(entity_type(r));
                 entity_type(r) = ImplicitType(r);
                 pips_assert("Result and function result types should be equal",
                             type_equal_p(functional_result(type_functional(tm)),
                                          entity_type(r)));
             }
             else {
                 pips_internal_error("Result entity should exist!");
             }
         }
     }
     else if (type_void_p(tr)) {
         /* nothing to be done: subroutine or main */
     }
     else
         pips_internal_error("Unexpected type with tag = %d",
                    type_tag(tr));
  
     pips_assert("Parameter type list should still be empty",
                 ENDP(functional_parameters(type_functional(tm))));
  
     pips_debug(8, "End for module %s\n",
           module_local_name(m));
 }

References code_declarations, ENDP, ENTITY, entity_function_p(), entity_initial, entity_local_name(), entity_storage, entity_type, entity_undefined, FindEntity(), formal_parameter_p(), free_type(), functional_parameters, functional_result, get_current_module_entity(), implicit_type_p(), ImplicitType(), MAP, module_local_name(), pips_assert, pips_debug, pips_internal_error, pips_user_warning, storage_ram_p, storage_rom_p, storage_undefined_p, type_equal_p(), type_functional, type_functional_p, type_tag, type_undefined, type_variable_p, type_void_p, value_code, and variable_entity_p().

Here is the call graph for this function:

◆ ReuseLabelledStatement()

statement ReuseLabelledStatement	(	statement	s,
		instruction	i
	)

Comments probably are lost...

Here, you are in trouble because the label cannot be carried by the block. It should be carried by the first statement of the block... which has already been allocated. This only should occur with desugared constructs because they must bypass the MakeStatement() module to handle statement numbering properly.

Reuse s1, the first statement of the block, to contain the whole block. Reuse s to contain the first instruction of the block.

s only has got a label

statement_number(s) = (instruction_goto_p(i))? STATEMENT_NUMBER_UNDEFINED : get_next_statement_number();

Let's number labelled GOTO because a CONTINUE is derived later from them

Definition at line 338 of file statement.c.

 {
     statement new_s = statement_undefined;
  
     debug(9, "ReuseLabelledStatement", "begin for label \"%s\"\n",
           label_local_name(statement_label(s)));
  
     pips_assert("Should have no number", 
                 statement_number(s)==STATEMENT_NUMBER_UNDEFINED);
     pips_assert("The statement instruction should be undefined",
                 instruction_undefined_p(statement_instruction(s)));
  
     if(instruction_loop_p(i) && get_bool_property("PARSER_SIMPLIFY_LABELLED_LOOPS")) {
         /* Comments probably are lost... */
         instruction c = make_continue_instruction();
         statement ls = instruction_to_statement(i);
  
         statement_number(ls) = get_statement_number();//get_next_statement_number();
         statement_instruction(s) = c;
  
         new_s = instruction_to_statement(
             make_instruction(is_instruction_sequence,
                              make_sequence(CONS(STATEMENT,s,
                                                 CONS(STATEMENT, ls, NIL)))));
     }
     else if(instruction_block_p(i)) {
         /* Here, you are in trouble because the label cannot be carried 
          * by the block. It should be carried by the first statement of
          * the block... which has already been allocated.
          * This only should occur with desugared constructs because they
          * must bypass the MakeStatement() module to handle statement
          * numbering properly.
          *
          * Reuse s1, the first statement of the block, to contain the
          * whole block. Reuse s to contain the first instruction of the
          * block.
          */
         statement s1 = STATEMENT(CAR(instruction_block(i)));
  
         pips_assert("The first statement of the block is not a block",
                     !statement_block_p(s1));
  
         /* s only has got a label */
         statement_number(s) = statement_number(s1);
         statement_ordering(s) = statement_ordering(s1);
         statement_comments(s) = statement_comments(s1);
         statement_instruction(s) = statement_instruction(s1);
  
         statement_label(s1) = entity_empty_label();
         statement_number(s1) = STATEMENT_NUMBER_UNDEFINED;
         statement_ordering(s1) = STATEMENT_ORDERING_UNDEFINED;
         statement_comments(s1) = empty_comments;
         statement_instruction(s1) = i;
  
         instruction_block(i) = CONS(STATEMENT, s,
                                     CDR(instruction_block(i)));
  
         pips_assert("The first statement of block s1 must be s\n",
                     STATEMENT(CAR(instruction_block(statement_instruction(s1))))
                     == s);
  
         new_s = s1;
     }
     else {
         statement_instruction(s) = i;
         /* 
            statement_number(s) = (instruction_goto_p(i))?
            STATEMENT_NUMBER_UNDEFINED : get_next_statement_number();
         */
         /* Let's number labelled GOTO because a CONTINUE is derived later from them */
         statement_number(s) = get_statement_number(); //get_next_statement_number();
         new_s = s;
     }
  
     debug(9, "ReuseLabelledStatement", "end for label \"%s\"\n",
           label_local_name(statement_label(s)));
  
     return new_s;
 }

References CAR, CDR, CONS, debug(), empty_comments, entity_empty_label(), get_bool_property(), get_statement_number(), instruction_block, instruction_block_p, instruction_loop_p, instruction_to_statement(), instruction_undefined_p, is_instruction_sequence, label_local_name(), make_continue_instruction(), make_instruction(), make_sequence(), NIL, pips_assert, s1, STATEMENT, statement_block_p, statement_comments, statement_instruction, statement_label, statement_number, STATEMENT_NUMBER_UNDEFINED, statement_ordering, STATEMENT_ORDERING_UNDEFINED, and statement_undefined.

Referenced by MakeStatement().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ SafeFindOrCreateEntity()

entity SafeFindOrCreateEntity	(	const char *	package,
		const char *	name
	)

Problem: A functional global entity may be referenced without parenthesis or CALL keyword in a function or subroutine call as functional parameter.

FindOrCreateEntity() will return a local variable which already is or will be in the ghost variable list. When ghost variables are eliminated the data structure using this local variable contain a pointer to nowhere.

However, SafeFindOrCreateEntity() does not solve this problem entirely. The call with a functional parameter may occur before a call to this functional parameter lets us find out it is indeed functional.

Morevover, SafeFindOrCreateEntity() does create new problem because intrinsic overloading is ignored. Fortran does not use reserved words and a local variable may have the same name as an intrinsics. The intrinsic entity returned by this function must later be converted into a local variable when it is found out that the user really wanted a local variable, for instance because it appears in a lhs. So intrinsics are not searched anymore.

This is yet another reason to split the building of the internal representation into three phases. The first phase should not assume any default type or storage. Then, type and storage are consolidated together and default type and storage are only used when no information is available. The last phase should be kind of a link edit. The references to really global variables and intrinsics have to be fixed by scanning the intermediate representation.

◆ SafeLocalToGlobal()

entity SafeLocalToGlobal	(	entity	e,
		type	r
	)

A local entity might have been created but found out later to be global, depending on the order of declaration statements (see MakeExternalFunction()).

The local entity e is (marked as) destroyed and replaced by functional entity fe.

Should we anticipate the value code, since we know it has to be a value code for a function and it may be tested later after the parsing phase of the caller but before the parsing phase of the callee, or should we wait till the code is really known?

entity_initial(fe) = make_value(is_value_unknown, UU);

FI: I need to destroy a virtual entity which does not appear in the program and wich was temporarily created by the parser when it recognized a name; however, I've no way to know if the same entity does not appear for good somewhere else in the code; does the Fortran standard let you write: LOG = LOG(3.) If yes, PIPS will core dump... PIPS also core dumps with ALOG(ALOG(X))... (8 July 1993)

remove_variable_entity(e);

ParserError("LocalToGlobal", "Formal functional parameters are not supported " "by PIPS.\n");

Definition at line 1681 of file procedure.c.

 {
     entity fe = entity_undefined;
  
     if(!top_level_entity_p(e)) {
         storage s = entity_storage(e);
         if(s == storage_undefined || storage_ram_p(s)) {
  
             fe = FindOrCreateEntity(TOP_LEVEL_MODULE_NAME,
                                     entity_local_name(e));
             if(storage_undefined_p(entity_storage(fe))) {
                 entity_storage(fe) = make_storage(is_storage_rom, UU);
             }
             else if(!storage_rom_p(entity_storage(fe))) {
                 FatalError("SafeLocalToGlobal",
                            "Unexpected storage class for top level entity\n");
             }
             if(value_undefined_p(entity_initial(fe))) {
               /* Should we anticipate the value code, since we know it has
                  to be a value code for a function and it may be tested
                  later after the parsing phase of the caller but before
                  the parsing phase of the callee, or should we wait till
                  the code is really known? */
               /* entity_initial(fe) = make_value(is_value_unknown, UU); */
                 entity_initial(fe) = make_value(is_value_code,
                 make_code(NIL, strdup(""), make_sequence(NIL),NIL,
                           make_language_fortran()));
             }
  
             pips_debug(1, "external function %s re-declared as %s\n",
                        entity_name(e), entity_name(fe));
             /* FI: I need to destroy a virtual entity which does not
              * appear in the program and wich was temporarily created by
              * the parser when it recognized a name; however, I've no way
              * to know if the same entity does not appear for good
              * somewhere else in the code; does the Fortran standard let
              * you write: LOG = LOG(3.)  If yes, PIPS will core dump...
              * PIPS also core dumps with ALOG(ALOG(X))... (8 July 1993) */
             /* remove_variable_entity(e); */
             if(type_undefined_p(r)) {
                 add_ghost_variable_entity(e);
                 pips_debug(1, "entity %s to be destroyed\n", entity_name(e));
             }
             else {
                 pips_debug(1, "entity %s to be preserved to carry function result\n",
                            entity_name(e));
             }
         }
         else if(storage_formal_p(s)){
             pips_user_warning("Variable %s is a formal functional parameter.\n"
                               "They are not (yet) supported by PIPS.\n",
                               entity_name(e));
             /* ParserError("LocalToGlobal",
                         "Formal functional parameters are not supported "
                         "by PIPS.\n"); */
             fe = e;
         }
         else {
             pips_internal_error("entity %s has an unexpected storage %d",
                                 entity_name(e), storage_tag(s));
         }
     }
     else {
         fe = e;
     }
     pips_assert("Entity is global or it is a formal functional parameter",
                 top_level_entity_p(fe) || storage_formal_p(entity_storage(fe)));
     return fe;
 }

References add_ghost_variable_entity(), entity_initial, entity_local_name(), entity_name, entity_storage, entity_undefined, FatalError, FindOrCreateEntity(), is_storage_rom, is_value_code, make_code(), make_language_fortran(), make_sequence(), make_storage(), make_value(), NIL, pips_assert, pips_debug, pips_internal_error, pips_user_warning, storage_formal_p, storage_ram_p, storage_rom_p, storage_tag, storage_undefined, storage_undefined_p, strdup(), top_level_entity_p(), TOP_LEVEL_MODULE_NAME, type_undefined_p, UU, and value_undefined_p.

Referenced by LocalToGlobal(), and MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ SafeSizeOfArray()

int SafeSizeOfArray ( entity a )

cproto-generated files

declaration.c

cproto-generated files

See ri-util/size.c: array_size()

Definition at line 83 of file declaration.c.

 {
   int s;
  
   if (!SizeOfArray(a, &s)) {
     pips_user_warning("Varying size of array \"%s\": An integer PARAMETER may "
                       "have been initialized with a real value?\n",
                       entity_name(a));
     ParserError(__FUNCTION__,
                 "Fortran standard prohibit varying size array\n"
                 "Set property PARSER_ACCEPT_ANSI_EXTENSIONS to true.\n");
   }
  
   return s;
 }

References entity_name, ParserError(), pips_user_warning, and SizeOfArray().

Referenced by ComputeAddresses(), CurrentOffsetOfArea(), and update_common_layout().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ save_all_entities()

void save_all_entities ( void )

functions for the SAVE declaration

FI: all variables previously allocated should be reallocated

FI: This is pretty crude... Let's hope it works

Definition at line 138 of file declaration.c.

 {
     entity mod = get_current_module_entity();
     list vars = code_declarations(value_code(entity_initial(mod)));
  
     pips_assert("save_all_entities", StaticArea != entity_undefined);
     pips_assert("save_all_entities", DynamicArea != entity_undefined);
  
     /* FI: all variables previously allocated should be reallocated */
  
     MAP(ENTITY, e, {
         storage s;
         if((s=entity_storage(e))!= storage_undefined) {
             if(storage_ram_p(s) && ram_section(storage_ram(s)) == DynamicArea) {
                 free_storage(entity_storage(e));
                 entity_storage(e) =
                     make_storage(is_storage_ram,
                                  (make_ram(mod,
                                            StaticArea, 
                                            current_offset_of_area(StaticArea ,e),
                                            NIL)));
             }
         }
     }, vars);
  
     /* FI: This is pretty crude... Let's hope it works */
     DynamicArea = StaticArea;
 }

References code_declarations, current_offset_of_area(), DynamicArea, ENTITY, entity_initial, entity_storage, entity_undefined, free_storage(), get_current_module_entity(), is_storage_ram, make_ram(), make_storage(), MAP, NIL, pips_assert, ram_section, StaticArea, storage_ram, storage_ram_p, storage_undefined, and value_code.

Here is the call graph for this function:

◆ save_initialized_variable()

void save_initialized_variable ( entity v )

Definition at line 287 of file declaration.c.

 {
   MakeVariableStatic(v, false);
 }

References MakeVariableStatic().

Here is the call graph for this function:

◆ SaveChains()

void SaveChains ( void )

Initialize the shared fields of aliased variables.

shared = CONS(ENTITY, atom_equivar(ATOM(CAR(pa))), shared);

Check conflicting intializations

Definition at line 859 of file equivalence.c.

 {
     pips_debug(8, "Begin\n");
  
     if (FinalEquivSet == equivalences_undefined) {
     pips_debug(8, "No equivalence to process. End\n");
         return;
     }
  
     MAPL(pc, {
         cons *shared = NIL;
         chain c = CHAIN(CAR(pc));
  
         pips_debug(8, "Process an equivalence chain:\n");
  
         MAPL(pa, {
           shared = gen_once(atom_equivar(ATOM(CAR(pa))), shared);
           /* shared = CONS(ENTITY, atom_equivar(ATOM(CAR(pa))), shared); */
         }, chain_atoms(c));
         
         pips_assert("SaveChains", !ENDP(shared));
  
         MAPL(pa, {
             atom a = ATOM(CAR(pa));
             entity e = atom_equivar(a);
             storage se = entity_storage(e);
             ram re = storage_ram(se);
  
             pips_debug(8, "\talias %s\n", entity_name(e));
  
             ram_shared(re) = gen_copy_seq(shared);
  
         }, chain_atoms(c));
  
         /* Check conflicting intializations */
         MAPL(pa, {
             atom a = ATOM(CAR(pa));
             entity e = atom_equivar(a);
             storage se = entity_storage(e);
             ram re = storage_ram(se);
             list lce = ram_shared(re);
  
             if(value_defined_p(entity_initial(e))
                && !value_unknown_p(entity_initial(e))) {
               pips_debug(8,
                     "\tCheck initalization consistency for %s\n",
                     entity_name(e));
               MAP(ENTITY, ce, {
                 if(e!=ce && variable_entities_may_conflict_p(e, ce)) {
                   if(value_defined_p(entity_initial(ce))
                      && !value_unknown_p(entity_initial(ce))) {
                     pips_user_warning("Overlapping initializations for %s and %s\n",
                                       entity_local_name(e), entity_local_name(ce));
                     ParserError("SaveChains",
                                 "ANSI extension: overlapping initializations\n");
                   }
                 }
               }, lce);
             }
  
         }, chain_atoms(c));
  
     }, equivalences_chains(FinalEquivSet));
  
     pips_debug(8, "End\n");
 }

References ATOM, atom_equivar, CAR, CHAIN, chain_atoms, ENDP, ENTITY, entity_initial, entity_local_name(), entity_name, entity_storage, equivalences_chains, equivalences_undefined, FinalEquivSet, gen_copy_seq(), gen_once(), MAP, MAPL, NIL, ParserError(), pips_assert, pips_debug, pips_user_warning, ram_shared, storage_ram, value_defined_p(), value_unknown_p, and variable_entities_may_conflict_p().

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ SaveCommon()

void SaveCommon ( entity c )

this function transforms a dynamic common into a static one.

Definition at line 295 of file declaration.c.

 {
     pips_assert("SaveCommon",type_area_p(entity_type(c)));
  
     Warning("SaveCommon", "common blocks are automatically saved\n");
  
     return;
 }

References entity_type, pips_assert, type_area_p, and Warning.

◆ SaveEntity()

void SaveEntity ( entity e )

These two functions transform a dynamic variable into a static one.

They are called to handle SAVE and DATA statements.

Because equivalence chains have not yet been processed, it is not possible to assign an offset or to chain the variable to the static area layout. These two updates are performed by ComputeAddresses() only called by EndOfProcedure() to make sure that all non-declared variables have been taken into account.

Let's hope functions and subroutines called are listed in the declaration list.

This cannot be done before the equivalences have been processed

Not much can be said. Maybe it is redundant, but...

Maybe the standard claims that you are not allowed to save a common variable?

The type and dimensions are still unknown

Definition at line 178 of file declaration.c.

 {
     entity g = local_name_to_top_level_entity(entity_local_name(e));
  
     if(!entity_undefined_p(g)
        /* Let's hope functions and subroutines called are listed in the
         * declaration list.
         */
        && entity_is_argument_p(g, code_declarations(value_code(entity_initial(get_current_module_entity()))))) {
         user_warning("SaveEntity", 
                      "Ambiguity between external %s and local %s forbidden by Fortran standard\n",
                      entity_name(g), entity_name(e));
         ParserError("SaveEntity", "Name conflict\n");
     }
  
     if (entity_type(e) == type_undefined) {
         DeclareVariable(e, type_undefined, NIL, 
                         storage_undefined, value_undefined);
     }
  
     if (entity_storage(e) != storage_undefined) {
         if (storage_ram_p(entity_storage(e))) {
             ram r;
  
             r = storage_ram(entity_storage(e));
  
             if (ram_section(r) == DynamicArea) {
                 /* This cannot be done before the equivalences have been processed */
                 /*
                 area a = type_area(entity_type(StaticArea));
                 area_layout(a) = gen_nconc(area_layout(a),
                                            CONS(ENTITY, e, NIL));
                 */
                 ram_section(r) = StaticArea;
                 ram_offset(r) = UNKNOWN_RAM_OFFSET;
             }
             else {
                 /* Not much can be said. Maybe it is redundant, but... */
                 /* Maybe the standard claims that you are not allowed
                  * to save a common variable?
                  */
                 /*
                   user_warning("SaveEntity", "Variable %s has already been declared static "
                   "by SAVE, by DATA or by appearing in a common declaration\n",
                   entity_local_name(e));
                 */
             }
         }
         else {
             user_warning("SaveEntity",
                          "Cannot save variable %s with non RAM storage (storage tag = %d)\n",
                          entity_local_name(e),
                          storage_tag(entity_storage(e)));
             ParserError("SaveEntity", "Cannot save this variable");
         }
     }
     else {
         entity_storage(e) =
             make_storage(is_storage_ram,
                          (make_ram(get_current_module_entity(), 
                                    StaticArea, 
                                    /* The type and dimensions are still unknown */
                                    UNKNOWN_RAM_OFFSET,
                                    NIL)));
     }
 }

References code_declarations, DeclareVariable(), DynamicArea, entity_initial, entity_is_argument_p(), entity_local_name(), entity_name, entity_storage, entity_type, entity_undefined_p, get_current_module_entity(), is_storage_ram, local_name_to_top_level_entity(), make_ram(), make_storage(), NIL, ParserError(), ram_offset, ram_section, StaticArea, storage_ram, storage_ram_p, storage_tag, storage_undefined, type_undefined, UNKNOWN_RAM_OFFSET, user_warning, value_code, and value_undefined.

Referenced by AnalyzeData(), fix_storage(), and MakeVariableStatic().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ScanFormalParameters()

void ScanFormalParameters	(	entity	m,
		list	l
	)

this function scans the formal parameter list.

each formal parameter is created with an implicit type, and then is added to CurrentFunction's declarations.

le parametre formel

son rang dans la liste

Definition at line 2503 of file procedure.c.

 {
         list pc;
         entity fp; /* le parametre formel */
         int nfp; /* son rang dans la liste */
  
         FormalParameters = l;
  
         for (pc = l, nfp = 1; pc != NULL; pc = CDR(pc), nfp += 1) {
                 fp = ENTITY(CAR(pc));
  
                 MakeFormalParameter(m, fp, nfp);
  
                 AddEntityToDeclarations(fp, m);
         }
 }

References AddEntityToDeclarations(), CAR, CDR, ENTITY, FormalParameters, and MakeFormalParameter().

Referenced by MakeCurrentFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ ScanNewFile()

void ScanNewFile ( void )

La fonction a appeler pour l'analyse d'un nouveau fichier.

on initialise la table keywidx

on met a jour la table keywidx en fonction des keywords

premier keyword commencant par keywcour[0]

on initialise les variables externes locales et non locales

Definition at line 474 of file reader.c.

 {
     register int i;
     static int FirstCall = true;
     char letcour, *keywcour;
  
  
     if (FirstCall) {
         FirstCall = false;
  
         /* on initialise la table keywidx */
         for (i = 0; i < 26; i += 1)
             keywidx[i] = UNDEF;
  
         /* on met a jour la table keywidx en fonction des keywords */
         letcour = ' ';
         i = 0;
         while ((keywcour = keywtbl[i].keywstr) != NULL) {
             if (keywcour[0] != letcour) {
                 /* premier keyword commencant par keywcour[0] */
                 keywidx[(int) keywcour[0]-'A'] = i;
                 letcour = keywcour[0];
             }
             i += 1;
         }
     }
  
     /* on initialise les variables externes locales et non locales */
     LineNumber = 1;
     Column = 1;
     StmtLineNumber = 1;
     EtatQuotes = NONINQUOTES;
     iStmt = lStmt = SIZE_UNDEF;
     iLine = lLine = UNDEF;
 }

References Column, EtatQuotes, iLine, int, iStmt, keywidx, keywtbl, LineNumber, lLine, lStmt, NONINQUOTES, SIZE_UNDEF, StmtLineNumber, and UNDEF.

Referenced by the_actual_parser().

Here is the caller graph for this function:

◆ set_alternate_returns()

void set_alternate_returns ( void )

Definition at line 264 of file return.c.

 {
     pips_assert("alternate return list is undefined", list_undefined_p(alternate_returns));
     alternate_returns = NIL;
     current_number_of_alternate_returns = 0;
 }

References alternate_returns, current_number_of_alternate_returns, list_undefined_p, NIL, and pips_assert.

◆ set_common_to_size()

void set_common_to_size	(	entity	a,
		size_t	size
	)

Parameters

size ize

Definition at line 1004 of file declaration.c.

 {
     (void) hash_put(common_size_map, (char *) a, (char *) (size));
 }

References common_size_map, and hash_put().

Referenced by gfc2pips_computeAdressesOfArea(), gfc2pips_namespace(), InitAreas(), and MakeCommon().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ set_current_label_string()

void set_current_label_string ( string ln )

Parameters

ln n

Definition at line 81 of file parser.c.

 {
     pips_assert("Label name is at most 5 characters long", strlen(ln)<=5);
     strcpy(lab_I, ln);
 }

References lab_I, and pips_assert.

Referenced by MakeElseInst().

Here is the caller graph for this function:

◆ set_current_number_of_alternate_returns()

void set_current_number_of_alternate_returns ( void )

Definition at line 187 of file return.c.

 {
   current_number_of_alternate_returns = 0;
 }

References current_number_of_alternate_returns.

Referenced by gfc2pips_args().

Here is the caller graph for this function:

◆ set_first_format_statement()

void set_first_format_statement ( void )

declaration_lines = line_b_I-1;

Definition at line 1952 of file statement.c.

 {
     if(!format_seen && !seen) {
         format_seen = true;
         /* declaration_lines = line_b_I-1; */
             debug(8, "set_first_format_statement", "line_b_C=%d, line_b_I=%d\n",
                   line_b_C, line_b_I);
         declaration_lines = (line_b_C!=UNDEF)?line_b_C-1:line_b_I-1;
     }
 }

References debug(), declaration_lines, format_seen, line_b_C, line_b_I, seen, and UNDEF.

Here is the call graph for this function:

◆ SetChains()

void SetChains ( void )

initialize chains before each call to the parser

Definition at line 76 of file equivalence.c.

 {
     pips_assert("TempoEquivSet is undefined", equivalences_undefined_p(TempoEquivSet));
     pips_assert("FinalEquivSet is undefined", equivalences_undefined_p(FinalEquivSet));
     TempoEquivSet = make_equivalences(NIL);
     FinalEquivSet = make_equivalences(NIL);
 }

References equivalences_undefined_p, FinalEquivSet, make_equivalences(), NIL, pips_assert, and TempoEquivSet.

Referenced by MakeCurrentFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ SizeOfRange()

int SizeOfRange ( range r )

This function computes the size of a range, ie.

the number of iterations that would be done by a loop with this range.

◆ soft_reset_alternate_returns()

void soft_reset_alternate_returns ( void )

ParserError() cannot guess if it has been performed or not, because it is reinitialized before and after each call statement.

If the error occurs within a call, alternate returns must be reset. Else they should not be reset.

Definition at line 284 of file return.c.

 {
   if(!list_undefined_p(alternate_returns)) {
     reset_alternate_returns();
   }
 }

References alternate_returns, list_undefined_p, and reset_alternate_returns().

Referenced by ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ StmtEqualString()

int StmtEqualString	(	char *	s,
		int	i
	)

Definition at line 1290 of file reader.c.

 {
     int result = false;
  
     if (strlen(s) <= lStmt-i) {
         while (*s)
             if (*s != stmt_buffer[i++])
                 break;
             else
                 s++;
  
         result = (*s) ? false : i;
     }
  
     return result;
 }

References false, lStmt, and stmt_buffer.

Referenced by FindAssign(), FindAutre(), FindDo(), FindDoWhile(), FindIf(), FindIfArith(), FindImplicit(), FindPoints(), and NeedKeyword().

Here is the caller graph for this function:

◆ StoreEquivChain()

void StoreEquivChain ( chain c )

This function is called when an equivalence chain has been completely parsed.

It looks for the atom with the biggest offset, and then substracts this maximum offset from all atoms. The result is that each atom has its offset from the begining of the chain.

Definition at line 176 of file equivalence.c.

 {
     cons * pc;
     int maxoff;
  
     maxoff = 0;
     for (pc = chain_atoms(c); pc != NIL; pc = CDR(pc)) {
         int o = atom_equioff(ATOM(CAR(pc)));
  
         if (o > maxoff)
                 maxoff = o;
     }
  
     pips_debug(9, "maxoff %d\n", maxoff);
  
     if (maxoff > 0) {
         for (pc = chain_atoms(c); pc != NIL; pc = CDR(pc)) {
             atom a = ATOM(CAR(pc));
  
             atom_equioff(a) = abs(atom_equioff(a)-maxoff);
         }
     }
  
     /*
     if (TempoEquivSet == equivalences_undefined) {
         TempoEquivSet = make_equivalences(NIL);
     }
     */
     pips_assert("The TempoEquivSet is defined", !equivalences_undefined_p(TempoEquivSet));
  
     equivalences_chains(TempoEquivSet) = 
             CONS(CHAIN, c, equivalences_chains(TempoEquivSet));
 }

References abs, ATOM, atom_equioff, CAR, CDR, CHAIN, chain_atoms, CONS, equivalences_chains, equivalences_undefined_p, NIL, pips_assert, pips_debug, and TempoEquivSet.

◆ substitute_ghost_variable_in_expression()

void substitute_ghost_variable_in_expression	(	expression	expr,
		entity	v,
		entity	f
	)

It is assumed that v and f are defined entities and that v is of type variable and f of type functional.

ParserError() is going to request ghost variable substitution recursively and we do not want this to happen because it is going to fail again. Well, substitution won't be tried from AbortOfProcedure()...

ghost_variable_entities = NIL;

ParserError("substitute_ghost_variable_in_expression", "Functional parameters are not (yet) supported by PIPS\n");

Parameters

expr xpr

Definition at line 75 of file procedure.c.

 {
     /* It is assumed that v and f are defined entities and that v is of
        type variable and f of type functional. */
     syntax s = expression_syntax(expr);
     reference ref = reference_undefined;
     range rng = range_undefined;
     call c = call_undefined;
  
     ifdebug(8) {
         pips_debug(8, "Begin for expression: ");
         print_expression(expr);
     }
  
     switch(syntax_tag(s)) {
     case is_syntax_reference:
         ref = syntax_reference(s);
         if(reference_variable(ref)==v) {
             pips_debug(1,
                   "Reference to formal functional entity %s to be substituted\n",
                   entity_name(f));
             /* ParserError() is going to request ghost variable
                substitution recursively and we do not want this to happen
                because it is going to fail again. Well, substitution won't be
                tried from AbortOfProcedure()... */
             /* ghost_variable_entities = NIL; */
             pips_user_warning(
                               "Functional variable %s is used as an actual argument\n"
                               "This is not yet fully supported by PIPS.\n",
                               module_local_name(f));
             /* ParserError("substitute_ghost_variable_in_expression",
                "Functional parameters are not (yet) supported by PIPS\n"); */
             reference_variable(ref)=f;
         }
         MAP(EXPRESSION, e, {
             substitute_ghost_variable_in_expression(e, v, f);
         }, reference_indices(ref));
         break;
     case is_syntax_range:
         rng = syntax_range(s);
         substitute_ghost_variable_in_expression(range_lower(rng), v, f);
         substitute_ghost_variable_in_expression(range_upper(rng), v, f);
         substitute_ghost_variable_in_expression(range_increment(rng), v, f);
         break;
     case is_syntax_call:
         c = syntax_call(s);
         pips_assert("Called entities are not substituted", call_function(c)!= v);
         MAP(EXPRESSION, e, {
             substitute_ghost_variable_in_expression(e, v, f);
         }, call_arguments(c));
         break;
     default:
       break;
     }
  
     ifdebug(8) {
         pips_debug(8, "End for expression: ");
         print_expression(expr);
     }
 }

References call_arguments, call_function, call_undefined, entity_name, EXPRESSION, expression_syntax, f(), ifdebug, is_syntax_call, is_syntax_range, is_syntax_reference, MAP, module_local_name(), pips_assert, pips_debug, pips_user_warning, print_expression(), range_increment, range_lower, range_undefined, range_upper, ref, reference_indices, reference_undefined, reference_variable, syntax_call, syntax_range, syntax_reference, and syntax_tag.

Referenced by substitute_ghost_variable_in_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ substitute_ghost_variable_in_statement()

void substitute_ghost_variable_in_statement	(	statement	stmt,
		entity	v,
		entity	f
	)

It is assumed that v and f are defined entities and that v is of type variable and f of type functional.

gen_recurse() is not used to control the context better

unstructured u = unstructured_undefined;

Local variables should also be checked

nothing to do

Parameters

stmt tmt

Definition at line 139 of file procedure.c.

 {
     /* It is assumed that v and f are defined entities and that v is of
        type variable and f of type functional. */
  
     /* gen_recurse() is not used to control the context better */
  
     entity sl = statement_label(stmt);
     instruction i = statement_instruction(stmt);
     loop l = loop_undefined;
     whileloop w = whileloop_undefined;
     test t = test_undefined;
     call c = call_undefined;
     /* unstructured u = unstructured_undefined; */
  
     pips_assert("Labels are not substituted", sl!= v);
  
     switch(instruction_tag(i)) {
     case is_instruction_sequence:
         MAP(STATEMENT, s, {
             substitute_ghost_variable_in_statement(s, v, f);
         }, instruction_block(i));
         break;
     case is_instruction_loop:
         l = instruction_loop(i);
         pips_assert("Loop indices are not substituted", loop_index(l)!= v);
         pips_assert("Loop labels are not substituted", loop_label(l)!= v);
         substitute_ghost_variable_in_expression(range_lower(loop_range(l)), v, f);
         substitute_ghost_variable_in_expression(range_upper(loop_range(l)), v, f);
         substitute_ghost_variable_in_expression(range_increment(loop_range(l)), v, f);
         substitute_ghost_variable_in_statement(loop_body(l), v, f);
         /* Local variables should also be checked */
         break;
     case is_instruction_whileloop:
         w = instruction_whileloop(i);
         pips_assert("WHILE loop labels are not substituted", whileloop_label(w)!= v);
         substitute_ghost_variable_in_expression(whileloop_condition(w), v, f);
         substitute_ghost_variable_in_statement(whileloop_body(w), v, f);
         /* Local variables should also be checked */
         break;
     case is_instruction_test:
         t = instruction_test(i);
         substitute_ghost_variable_in_expression(test_condition(t), v, f);
         substitute_ghost_variable_in_statement(test_true(t), v, f);
         substitute_ghost_variable_in_statement(test_false(t), v, f);
         break;
     case is_instruction_goto:
         /* nothing to do */
         break;
     case is_instruction_call:
         c = instruction_call(i);
         pips_assert("Called entities are not substituted", call_function(c)!= v);
         MAP(EXPRESSION, e, {
             substitute_ghost_variable_in_expression(e, v, f);
         }, call_arguments(c));
         break;
     case is_instruction_unstructured:
         pips_assert("The parser should not have to know about unstructured\n", false);
         break;
     default:
         FatalError("substitute_ghost_variable_in_statement", "Unexpected instruction tag");
     }
 }

References call_arguments, call_function, call_undefined, EXPRESSION, f(), FatalError, instruction_block, instruction_call, instruction_loop, instruction_tag, instruction_test, instruction_whileloop, is_instruction_call, is_instruction_goto, is_instruction_loop, is_instruction_sequence, is_instruction_test, is_instruction_unstructured, is_instruction_whileloop, loop_body, loop_index, loop_label, loop_range, loop_undefined, MAP, pips_assert, range_increment, range_lower, range_upper, STATEMENT, statement_instruction, statement_label, substitute_ghost_variable_in_expression(), test_condition, test_false, test_true, test_undefined, whileloop_body, whileloop_condition, whileloop_label, and whileloop_undefined.

Referenced by remove_ghost_variable_entities().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ SubstituteAlternateReturns()

void SubstituteAlternateReturns ( const char * option )

return.c

Parameters

option ption

Definition at line 59 of file return.c.

 {
     substitute_rc_p = (strcmp(option, "RC")==0) || (strcmp(option, "HRC")==0) ;
     hide_rc_p = (strcmp(option, "HRC")==0) ;
     substitute_stop_p = (strcmp(option, "STOP")==0);
  
     if(!(substitute_rc_p || substitute_stop_p || strcmp(option, "NO")==0)) {
         user_log("Unknown option \"%s\" for property "
                  "PARSER_SUBSTITUTE_ALTERNATE_RETURNS.\n"
                  "Three options are available for alternate return handling: "
                  "\"NO\", \"RC\" and \"STOP\"\n", option);
         ParserError("SubstituteAlternateReturns", "Illegal property value");
     }
  
     if((substitute_rc_p || substitute_stop_p)
        && !get_bool_property("PRETTYPRINT_ALL_DECLARATIONS"))
         user_warning("SubstituteAlternateReturns",
                      "Module declarations should be regenerated."
                      " Set property PRETTYPRINT_ALL_DECLARATIONS.\n");
 }

References get_bool_property(), hide_rc_p, ParserError(), substitute_rc_p, substitute_stop_p, user_log(), and user_warning.

Referenced by EndOfProcedure(), MakeCurrentFunction(), and ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ SubstituteAlternateReturnsP()

bool SubstituteAlternateReturnsP ( void )

Definition at line 81 of file return.c.

 {
     return substitute_rc_p;
 }

References substitute_rc_p.

Referenced by MakeCallInst(), and MakeFormalParameter().

Here is the caller graph for this function:

◆ syn_alloc()

void* syn_alloc ( yy_size_t )

◆ syn_error()

void syn_error ( const char * )

◆ syn_free()

void syn_free ( void * )

◆ syn_get_debug()

int syn_get_debug ( void )

◆ syn_get_in()

FILE* syn_get_in ( void )

◆ syn_get_leng()

int syn_get_leng ( void )

◆ syn_get_lineno()

int syn_get_lineno ( void )

◆ syn_get_out()

FILE* syn_get_out ( void )

◆ syn_get_text()

char* syn_get_text ( void )

◆ syn_lex()

int syn_lex ( )

◆ syn_lex_destroy()

int syn_lex_destroy ( void )

◆ syn_parse()

int syn_parse ( )

◆ syn_pop_buffer_state()

void syn_pop_buffer_state ( void )

◆ syn_realloc()

void* syn_realloc	(	void *	,
		yy_size_t
	)

◆ syn_reset_lex()

void syn_reset_lex ( )

◆ syn_restart()

void syn_restart ( FILE * )

◆ syn_set_debug()

void syn_set_debug ( int )

◆ syn_set_in()

void syn_set_in ( FILE * )

◆ syn_set_lineno()

void syn_set_lineno ( int )

◆ syn_set_out()

void syn_set_out ( FILE * )

◆ syn_wrap()

int syn_wrap ( void )

Definition at line 466 of file reader.c.

 {
         return(1);
 }

◆ TypeFunctionalEntity()

void TypeFunctionalEntity	(	entity	fe,
		type	r
	)

this is wrong, because we do not know if we are handling an EXTERNAL declaration, in which case the result type is type_undefined, or a function call appearing somewhere, in which case the ImplicitType should be used; maybe the unknown type should be used?

a bug is detected here: MakeExternalFunction, as its name implies, always makes a FUNCTION, even when the symbol appears in an EXTERNAL statement; the result type is infered from ImplicitType() - see just above -; let's use implicit_type_p() again, whereas the unknown type should have been used

ignore r

someone used a subroutine as a function. this happens in hpfc for declaring "pure" routines. thus I make this case being ignored. warning? FC.

memory leak of tr

This may be an undeclared formal functional argument, initially assumed to be a variable. Since it is not declared as an array but appears with arguments, it must be a functional entity.

I do not know how to get the argument types. Let's hope it's performed later...

Parameters

fe e

Definition at line 2257 of file procedure.c.

 {
     type tfe = entity_type(fe);
  
     if(tfe == type_undefined) {
         /* this is wrong, because we do not know if we are handling
            an EXTERNAL declaration, in which case the result type
            is type_undefined, or a function call appearing somewhere,
            in which case the ImplicitType should be used;
            maybe the unknown type should be used? */
         entity_type(fe) = make_type(is_type_functional,
                                    make_functional(NIL,
                                                    (r == type_undefined) ?
                                                    ImplicitType(fe) :
                                                    r));
     }
     else if (type_functional_p(tfe))
     {
         type tr = functional_result(type_functional(tfe));
         if(r != type_undefined && !type_equal_p(tr, r)) {
  
             /* a bug is detected here: MakeExternalFunction, as its name
                implies, always makes a FUNCTION, even when the symbol
                appears in an EXTERNAL statement; the result type is
                infered from ImplicitType() - see just above -;
                let's use implicit_type_p() again, whereas the unknown type
                should have been used
             */
             if(intrinsic_entity_p(fe)) {
                 /* ignore r */
             } else if (type_void_p(tr)) {
                 /* someone used a subroutine as a function.
                  * this happens in hpfc for declaring "pure" routines.
                  * thus I make this case being ignored. warning? FC.
                  */
             } else if (implicit_type_p(fe) || overloaded_type_p(tr)) {
                 /* memory leak of tr */
                 functional_result(type_functional(tfe)) = r;
             } else  {
                 user_warning("TypeFunctionalEntity",
                              "Type redefinition of result for function %s\n",
                              entity_name(fe));
                 if(type_variable_p(tr)) {
                     user_warning("TypeFunctionalEntity",
                                  "Currently declared result is %s\n",
                                  basic_to_string(variable_basic(type_variable(tr))));
                 }
                 if(type_variable_p(r)) {
                     user_warning("TypeFunctionalEntity",
                                  "Redeclared result is %s\n",
                                  basic_to_string(variable_basic(type_variable(r))));
                 }
                 ParserError("TypeFunctionalEntity",
                             "Functional type redefinition.\n");
             }
         }
     } else if (type_variable_p(tfe)) {
       /* This may be an undeclared formal functional argument, initially
          assumed to be a variable. Since it is not declared as an array
          but appears with arguments, it must be a functional entity. */
       storage sfe = entity_storage(fe);
  
       if(storage_formal_p(sfe)) {
         /* I do not know how to get the argument types. Let's hope it's
            performed later...*/
         free_type(entity_type(fe));
         entity_type(fe) = make_type(is_type_functional,
                                     make_functional(NIL, r));
       }
       else {
         pips_internal_error("Fortran does not support global variables");
       }
     } else {
         pips_internal_error("Unexpected type for a global name %s",
                             entity_name(fe));
     }
 }

References basic_to_string(), entity_name, entity_storage, entity_type, free_type(), functional_result, implicit_type_p(), ImplicitType(), intrinsic_entity_p(), is_type_functional, make_functional(), make_type(), NIL, overloaded_type_p(), ParserError(), pips_internal_error, storage_formal_p, type_equal_p(), type_functional, type_functional_p, type_undefined, type_variable, type_variable_p, type_void_p, user_warning, and variable_basic.

Referenced by MakeEntry(), and MakeExternalFunction().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_called_modules()

void update_called_modules ( entity e )

Self recursive calls are not allowed

do not count intrinsics; user function should not be named like intrinsics

FI, 20/01/92: maybe, initializations of global entities should be more precise (storage, initial value, etc...); for the time being, I choose to ignore the potential problems with other executions of the parser and the linker

pips_internal_error("unexpected case");

Definition at line 308 of file procedure.c.

 {
     bool already_here = false;
     const char* n = entity_local_name(e);
     string nom;
     entity cm = get_current_module_entity();
  
     /* Self recursive calls are not allowed */
     if(e==cm) {
         pips_user_warning("Recursive call from %s to %s\n",
                      entity_local_name(cm), entity_local_name(e));
         ParserError("update_called_modules",
                     "Recursive call are not supported\n");
     }
  
     /* do not count intrinsics; user function should not be named
        like intrinsics */
     nom = concatenate(TOP_LEVEL_MODULE_NAME, MODULE_SEP_STRING, n, NULL);
     if ((e = gen_find_tabulated(nom, entity_domain)) != entity_undefined) {
         if(entity_initial(e) == value_undefined) {
             /* FI, 20/01/92: maybe, initializations of global entities
                should be more precise (storage, initial value, etc...);
                for the time being, I choose to ignore the potential
                problems with other executions of the parser and the linker */
             /* pips_internal_error("unexpected case"); */
         }
         else if(value_intrinsic_p(entity_initial(e)))
             return;
     }
  
     MAPL(ps, {
         if (strcmp(n, STRING(CAR(ps))) == 0) {
             already_here = true;
             break;
         }
     }, called_modules);
  
     if (! already_here) {
         pips_debug(1, "adding %s\n", n);
         called_modules = CONS(STRING, strdup(n), called_modules);
     }
 }

References called_modules, CAR, concatenate(), CONS, entity_domain, entity_initial, entity_local_name(), entity_undefined, gen_find_tabulated(), get_current_module_entity(), MAPL, MODULE_SEP_STRING, ParserError(), pips_debug, pips_user_warning, strdup(), STRING, TOP_LEVEL_MODULE_NAME, value_intrinsic_p, and value_undefined.

Referenced by make_get_rc_statement(), MakeAtom(), MakeCallInst(), and set_rc_function().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_common_layout()

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) the size of common c for the whole program or set of modules in the current workspace.

As a consequence, warning messages unfortunately depend on the parsing order.

Offsets used to be computed a first time when the common declaration is encountered, but the variables may be typed or dimensionned later.

This function is correct only if no equivalenced variables have been added to the layout. It should not be used for the static and dynamic areas (see below).

It is assumed that:

each variable appears only once
variables appears in their declaration order
all variables that belong to the same module appear contiguously (i.e. declarations are concatenated on a module basis)
variables wich are located in the common thru an EQUIVALENCE statement are not (yet) in its layout It also was wrongly assumed that each common would have at least two members.

the layout field does not seem to be filled in for STATIC and DYNAMIC

skip variables which do not belong to the module of interest

This should now always be the case. The offset within the common is no longer computed on the fly.

If c really is a common, check its size because it may have increased. Note that decreases are not taken into account although they might occur as well.

Too late, if the common only contains one element because the MAPL has not been entered at all if we are dealing wih te last parsed module... which is always the case up to now!

Variables declared in the static and dynamic areas were assigned offsets dynamically. The result may be ok.

Special case: only one element in the common for the current procedure (and the current procedure is last one declared - which is not so special)

If c really is a common, check its size because it may have increased. Note that decreases are not taken into account although they might occur as well.

Definition at line 1746 of file declaration.c.

 {
     /* It is assumed that:
      *  - each variable appears only once
      *  - variables appears in their declaration order
      *  - all variables that belong to the same module appear contiguously
      *    (i.e. declarations are concatenated on a module basis)
      *  - variables wich are located in the common thru an EQUIVALENCE statement
      *    are *not* (yet) in its layout
      * It also was wrongly assumed that each common would have at least two members.
      */
  
     list members = area_layout(type_area(entity_type(c)));
     entity previous = entity_undefined;
     bool updated = false;
     list cm = list_undefined;
  
     ifdebug(8) {
         debug(8, "update_common_layout",
               "Begin for common /%s/ with members\n", module_local_name(c));
         print_arguments(members);
     }
  
     /* the layout field does not seem to be filled in for STATIC and DYNAMIC */
     if(!ENDP(members)) {
         /* skip variables which do not belong to the module of interest */
         /*
         for(previous = ENTITY(CAR(members)); !ENDP(members) && !variable_in_module_p(previous, m);
             POP(members))
             previous = ENTITY(CAR(members));
             */
         do {
             previous = ENTITY(CAR(members));
             POP(members);
         } while(!ENDP(members) && !variable_in_module_p(previous, m));
  
         for(cm = members; !ENDP(cm); POP(cm)) {
             entity current = ENTITY(CAR(cm));
         
             pips_assert("update_common_layout",
                         storage_ram_p(entity_storage(current)));
  
             if(!variable_in_module_p(current, m)) {
                 break;
             }
  
             if(ram_offset(storage_ram(entity_storage(previous)))+SafeSizeOfArray(previous) >
                ram_offset(storage_ram(entity_storage(current)))) {
                 /* This should now always be the case. The offset within the common is
                  * no longer computed on the fly.
                  */
                 ram_offset(storage_ram(entity_storage(current))) =
                     ram_offset(storage_ram(entity_storage(previous)))+SafeSizeOfArray(previous);
  
                 /* If c really is a common, check its size because it may have increased.
                  * Note that decreases are not taken into account although they might
                  * occur as well.
                  */
                 /* Too late, if the common only contains one element because the MAPL
                  * has not been entered at all if we are dealing wih te last parsed
                  * module... which is always the case up to now!
                  */
                 if(top_level_entity_p(c) || entity_special_area_p(c)) {
                     int s = common_to_size(c);
                     int new_s = ram_offset(storage_ram(entity_storage(current)))
                         +SafeSizeOfArray(current);
                     if(s < new_s) {
                         (void) update_common_to_size(c, new_s);
                     }
                 }
                 updated = true;
             }
             else {
                 /* Variables declared in the static and dynamic areas were
                    assigned offsets dynamically. The result may be
                    ok. */
                 pips_assert("Offsets should always be updated",entity_special_area_p(c));
             }
  
             previous = current;
         }
  
  
         /* Special case: only one element in the common for the current procedure
          * (and the current procedure is last one declared - which is not so
          * special)
          */
         if(ENDP(members)) {
           pips_assert("Previous must in declared in the current module",
                       variable_in_module_p(previous, m));
           /* If c really is a common, check its size because it may have increased.
            * Note that decreases are not taken into account although they might
            * occur as well.
            */
           if(top_level_entity_p(c)) {
             int s = common_to_size(c);
             int new_s = ram_offset(storage_ram(entity_storage(previous)))
               +SafeSizeOfArray(previous);
             if(s < new_s) {
               (void) update_common_to_size(c, new_s);
               updated = true;
             }
           }
         }
     }
         debug(8, "update_common_layout",
               "End for common /%s/: updated=%s\n",
               module_local_name(c), bool_to_string(updated));
  
     return updated;
 }

References area_layout, bool_to_string(), CAR, common_to_size(), current, debug(), ENDP, ENTITY, entity_special_area_p(), entity_storage, entity_type, entity_undefined, ifdebug, list_undefined, module_local_name(), pips_assert, POP, print_arguments(), ram_offset, SafeSizeOfArray(), storage_ram, storage_ram_p, top_level_entity_p(), type_area, update_common_to_size(), and variable_in_module_p().

Referenced by update_user_common_layouts().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_common_sizes()

void update_common_sizes ( void )

I'm afraid this warning might be printed because area_size is given a wrong value by CurrentOffsetOfArea().

reset_common_size_map();

Definition at line 1215 of file declaration.c.

 {
   list commons = NIL;
  
   HASH_MAP(k, v,{
       entity c = (entity) k;
       commons = arguments_add_entity(commons, c);
     },
     common_size_map);
  
   sort_list_of_entities(commons);
  
   FOREACH(ENTITY, c, commons)
   {
     intptr_t s = common_to_size(c);
     type tc = entity_type(c);
     area ac = type_area(tc);
  
     pips_assert("update_common_sizes", s != (intptr_t) HASH_UNDEFINED_VALUE);
  
     if(area_size(ac) == 0) {
       area_size(ac) = s;
       pips_debug(1, "set size %zd for common %s\n", s, entity_name(c));
     }
     else if (area_size(ac) != s) {
       /* I'm afraid this warning might be printed because area_size is given
        * a wrong value by CurrentOffsetOfArea().
        */
       user_warning("update_common_sizes",
                    "inconsistent size (%d and %d) for common /%s/ in %s\n"
                    "Best results are obtained if all instances of a "
                    "COMMON are declared the same way.\n",
                    area_size(ac), s, module_local_name(c),
                    CurrentPackage);
       if(area_size(ac) < s)
         area_size(ac) = s;
     }
     else {
       debug(1, "update_common_sizes",
             "reset size %d for common %s\n", s, entity_name(c));
     }
   }
   // Postpone the resetting because DynamicArea is updated till EndOfProcedure()
   /* reset_common_size_map(); */
  
   gen_free_list(commons);
 }

References area_size, arguments_add_entity(), common_size_map, common_to_size(), CurrentPackage, debug(), ENTITY, entity_name, entity_type, FOREACH, gen_free_list(), HASH_MAP, HASH_UNDEFINED_VALUE, intptr_t, module_local_name(), NIL, pips_assert, pips_debug, sort_list_of_entities(), tc, type_area, and user_warning.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_common_to_size()

void update_common_to_size	(	entity	a,
		size_t	new_size
	)

Parameters

new_size ew_size

Definition at line 1010 of file declaration.c.

 {
     (void) hash_update(common_size_map, (char *) a, (char *) (new_size));
 }

References common_size_map, and hash_update().

Referenced by ComputeAddresses(), CurrentOffsetOfArea(), and update_common_layout().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_functional_type_result()

void update_functional_type_result	(	entity	f,
		type	nt
	)

Update of the type returned by function f.

nt must be a freshly allocated object. It is included in f's data structure

The function is probably a formal parameter, its type is wrong. The return type is either void if it is called by CALL or its current implicit type.

Parameters

nt t

Definition at line 932 of file statement.c.

 {
   type ft = entity_type(f);
   type rt = type_undefined;
  
   //pips_assert("function type is functional", type_functional_p(ft));
   if(!type_functional_p(ft)) {
     /* The function is probably a formal parameter, its type is
        wrong. The return type is either void if it is called by CALL
        or its current implicit type. */
     if(storage_formal_p(entity_storage(f))) {
       pips_user_warning("Variable \"%s\" is a formal functional parameter\n",
                         entity_user_name(f));
       ParserError(__FUNCTION__,
                   "Formal functional parameters are not yet supported\n");
     }
     else {
       pips_internal_error("Unexpected case");
     }
   }
   else {
     rt = functional_result(type_functional(ft));
   }
  
   pips_assert("result type is variable or unkown or void or undefined",
               type_undefined_p(rt)
               || type_unknown_p(rt)
               || type_void_p(rt)
               || type_variable_p(rt));
  
   pips_assert("new result type is variable or void",
               type_void_p(nt)
               ||type_variable_p(nt));
  
   free_type(rt);
   functional_result(type_functional(ft)) = nt;
 }

References entity_storage, entity_type, entity_user_name(), f(), free_type(), functional_result, ParserError(), pips_assert, pips_internal_error, pips_user_warning, storage_formal_p, type_functional, type_functional_p, type_undefined, type_undefined_p, type_unknown_p, type_variable_p, and type_void_p.

Referenced by MakeCallInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_functional_type_with_actual_arguments()

void update_functional_type_with_actual_arguments	(	entity	e,
		list	l
	)

OK, it is not safe: may be it's a 0-ary function

The pre-existing typing of e should match the new one

parameter p = parameter_undefined;

OK

the actual parameter list must be exhausted

as well as the type parameter list

unless the last type in the parameter list is a varargs

Definition at line 971 of file statement.c.

 {
   list pc = list_undefined;
   list pc2 = list_undefined;
   type t = type_undefined;
   functional ft = functional_undefined;
  
   pips_assert("update_functional_type_with_actual_arguments", !type_undefined_p(entity_type(e)));
   t = entity_type(e);
   pips_assert("update_functional_type_with_actual_arguments", type_functional_p(t));
   ft = type_functional(t);
  
  
   if( ENDP(functional_parameters(ft))) {
     /* OK, it is not safe: may be it's a 0-ary function */
     for (pc = l; pc != NULL; pc = CDR(pc)) {
       expression ae = EXPRESSION(CAR(pc));
       type t = type_undefined;
       parameter p = parameter_undefined;
  
       if(expression_reference_p(ae)) {
         reference r = expression_reference(ae);
         type tv = entity_type(reference_variable(r));
  
         if(type_functional_p(tv)) {
           pips_user_warning("Functional actual argument %s found.\n"
                             "Functional arguments are not yet suported by PIPS\n",
                             entity_local_name(reference_variable(r)));
         }
  
         t = copy_type(tv);
       }
       else {
         basic b = basic_of_expression(ae);
         variable v = make_variable(b, NIL,NIL); 
         t = make_type(is_type_variable, v);
       }
  
       p = make_parameter(t,
                          MakeModeReference(),
                          make_dummy_unknown());
       functional_parameters(ft) = 
         gen_nconc(functional_parameters(ft),
                   CONS(PARAMETER, p, NIL));
     }
   }
   else if(get_bool_property("PARSER_TYPE_CHECK_CALL_SITES"))  {
     /* The pre-existing typing of e should match the new one */
     int i = 0;
     bool warning_p = false;
  
     for (pc = l, pc2 = functional_parameters(ft), i = 1;
          !ENDP(pc) && !ENDP(pc2);
          POP(pc), i++) {
       expression ae = EXPRESSION(CAR(pc));
       type at = type_undefined;
       type ft = parameter_type(PARAMETER(CAR(pc2)));
       type eft = type_varargs_p(ft)? type_varargs(ft) : ft;
       /* parameter p = parameter_undefined; */
  
       if(expression_reference_p(ae)) {
         reference r = expression_reference(ae);
         type tv = entity_type(reference_variable(r));
  
         if(type_functional_p(tv)) {
           pips_user_warning("Functional actual argument %s found.\n"
                             "Functional arguments are not yet suported by PIPS\n",
                             entity_local_name(reference_variable(r)));
         }
  
         at = copy_type(tv);
       }
       else {
         basic b = basic_of_expression(ae);
         variable v = make_variable(b, NIL,NIL); 
  
         at = make_type(is_type_variable, v);
       }
  
       if((type_variable_p(eft)
           && basic_overloaded_p(variable_basic(type_variable(eft))))
          || type_equal_p(at, eft)) {
         /* OK */
         if(!type_varargs_p(ft)) 
           POP(pc2);
       }
       else {
         user_warning("update_functional_type_with_actual_arguments",
                      "incompatible %d%s actual argument and type in call to %s "
                      "between lines %d and %d. Current type is not updated\n",
                      i, nth_suffix(i),
                      module_local_name(e), line_b_I, line_e_I);
         free_type(at);
         warning_p = true;
         break;
       }
       free_type(at);
     }
  
     if(!warning_p) {
       if(!(ENDP(pc) /* the actual parameter list must be exhausted */
            && (ENDP(pc2) /* as well as the type parameter list */
                || (ENDP(CDR(pc2)) /* unless the last type in the parameter list is a varargs */
                    && type_varargs_p(parameter_type(PARAMETER(CAR(pc2)))))))) {
         user_warning("update_functional_type_with_actual_arguments",
                      "inconsistent arg. list lengths for %s:\n"
                      " %d args according to type and %d actual arguments\n"
                      "between lines %d and %d. Current type is not updated\n",
                      module_local_name(e),
                      gen_length(functional_parameters(ft)), 
                      gen_length(l), line_b_I, line_e_I);
       }
     }
   }
 }

References basic_of_expression(), basic_overloaded_p, CAR, CDR, CONS, copy_type(), ENDP, entity_local_name(), entity_type, EXPRESSION, expression_reference(), expression_reference_p(), free_type(), functional_parameters, functional_undefined, gen_length(), gen_nconc(), get_bool_property(), is_type_variable, line_b_I, line_e_I, list_undefined, make_dummy_unknown(), make_parameter(), make_type(), make_variable(), MakeModeReference(), module_local_name(), NIL, nth_suffix(), PARAMETER, parameter_type, parameter_undefined, pips_assert, pips_user_warning, POP, reference_variable, type_equal_p(), type_functional, type_functional_p, type_undefined, type_undefined_p, type_varargs, type_varargs_p, type_variable, type_variable_p, user_warning, and variable_basic.

Referenced by MakeAtom(), and MakeCallInst().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_user_common_layouts()

void update_user_common_layouts ( entity m )

Check...

and fix, if needed!

Only user COMMONs are checked. The two implicit areas, DynamicArea and StaticArea, have not been initialized yet (see ComputeAddress() and the calls in EndOfProcedure()).

List of implicitly and explicitly declared variables, functions and areas

Structure of each area/common

User declarations of commons imply the offset and cannot conflict with equivalences, whereas static and dynamic variables must first comply with equivalences. Hence the layouts of user commons must be updated before equivalences are satisfied whereas layouts of the static and dynamic areas must be satisfied after the equiavelences have been processed.

Definition at line 1670 of file declaration.c.

 {
     list decls = NIL;
     list sorted_decls = NIL;
  
     pips_assert("update_user_common_layouts", entity_module_p(m));
  
     decls = code_declarations(value_code(entity_initial(m)));
     sorted_decls = gen_append(decls, NIL);
     sort_list_of_entities(sorted_decls);
  
     ifdebug(1) {
         pips_debug(1, "\nDeclarations for module %s\n", module_local_name(m));
  
         /* List of implicitly and explicitly declared variables, 
            functions and areas */
  
         pips_debug(1, "%s\n", ENDP(decls)? 
                    "* empty declaration list *\n\n": "Variable list:\n\n");
  
         MAP(ENTITY, e, 
             fprintf(stderr, "Declared entity %s\n", entity_name(e)),
             sorted_decls);
  
         /* Structure of each area/common */
         if(!ENDP(decls)) {
             (void) fprintf(stderr, "\nLayouts for areas (commons):\n\n");
         }
     }
  
     MAP(ENTITY, e, {
         if(type_area_p(entity_type(e))) {
             ifdebug(1) {
                 print_common_layout(stderr, e, true);
             }
             if(!entity_special_area_p(e)) {
                 /* User declarations of commons imply the offset and
                    cannot conflict with equivalences, whereas static and
                    dynamic variables must first comply with
                    equivalences. Hence the layouts of user commons must be
                    updated before equivalences are satisfied whereas
                    layouts of the static and dynamic areas must be
                    satisfied after the equiavelences have been
                    processed. */
                 if(update_common_layout(m, e)) {
                     ifdebug(1) {
                         print_common_layout(stderr, e, true);
                     }
                 }
             }
         }
     }, sorted_decls);
  
     gen_free_list(sorted_decls);
  
     pips_debug(1, "End of declarations for module %s\n\n",
                module_local_name(m));
 }

References code_declarations, ENDP, ENTITY, entity_initial, entity_module_p(), entity_name, entity_special_area_p(), entity_type, fprintf(), gen_append(), gen_free_list(), ifdebug, MAP, module_local_name(), NIL, pips_assert, pips_debug, print_common_layout(), sort_list_of_entities(), type_area_p, update_common_layout(), and value_code.

Referenced by EndOfProcedure().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ UpdateFormalStorages()

void UpdateFormalStorages	(	entity	m,
		list	lfp
	)

this function check and set if necessary the storage of formal parameters in lfp.

formal parameter chunk

formal parameter offset

Oupss... the associated area should be cleaned up... but it should ony occur in EndOfProcedure() when all implictly declared variables have been encountered...

Parameters

lfp fp

Definition at line 2522 of file procedure.c.

 {
     list fpc; /* formal parameter chunk */
     int fpo; /* formal parameter offset */
  
     for (fpc = lfp, fpo = 1; !ENDP(fpc); POP(fpc), fpo += 1) {
         entity fp = ENTITY(CAR(fpc));
         storage fps = entity_storage(fp);
  
         pips_assert("Formal parameter fp must be in scope of module m",
                     m==local_name_to_top_level_entity(entity_module_name(fp)));
  
         if(storage_undefined_p(fps)) {
             entity_storage(fp) = make_storage(is_storage_formal,
                                               make_formal(m, fpo));
         }
         else if(storage_ram_p(fps)){
             /* Oupss... the associated area should be cleaned up...  but
              * it should ony occur in EndOfProcedure() when all implictly
              * declared variables have been encountered...
              */
             free_storage(fps);
             entity_storage(fp) = make_storage(is_storage_formal,
                                               make_formal(m, fpo));
         }
         else if(storage_formal_p(fps)){
             pips_assert("Consistent Offset",
                         fpo==formal_offset(storage_formal(fps)));
         }
         else {
             pips_internal_error("Unexpected storage for entity %s",
                                 entity_name(fp));
         }
     }
 }

References CAR, ENDP, ENTITY, entity_module_name(), entity_name, entity_storage, formal_offset, free_storage(), is_storage_formal, local_name_to_top_level_entity(), make_formal(), make_storage(), pips_assert, pips_internal_error, POP, storage_formal, storage_formal_p, storage_ram_p, and storage_undefined_p.

Referenced by MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ UpdateFunctionalType()

void UpdateFunctionalType	(	entity	f,
		list	l
	)

This function analyzes the CurrentFunction formal parameter list to determine the CurrentFunction functional type.

l is this list.

It is called by EndOfProcedure().

FI: I do not understand this assert... at least now that functions may be typed at call sites. I do not understand why this assert has not made more damage. Only OVL in APSI (Spec-cfp95) generates a core dump. To be studied more!

This assert is guaranteed by MakeCurrentFunction() but not by retype_formal_parameters() which is called in case an intrinsic statement is encountered. It is not guaranteed by MakeExternalFunction() which uses the actual parameter list to estimate a functional type

Definition at line 1131 of file procedure.c.

 {
     cons *pc;
     parameter p;
     functional ft;
     entity CurrentFunction = f;
     type t = entity_type(CurrentFunction);
  
     ifdebug(8) {
         pips_debug(8, "Begin for %s with type ",
               module_local_name(CurrentFunction));
         fprint_functional(stderr, type_functional(t));
         (void) fprintf(stderr, "\n");
     }
  
     pips_assert("A module type should be functional", type_functional_p(t));
  
     ft = type_functional(t);
  
     /* FI: I do not understand this assert... at least now that
      * functions may be typed at call sites. I do not understand why this
      * assert has not made more damage. Only OVL in APSI (Spec-cfp95)
      * generates a core dump. To be studied more!
      *
      * This assert is guaranteed by MakeCurrentFunction() but not by
      * retype_formal_parameters() which is called in case an intrinsic
      * statement is encountered. It is not guaranteed by MakeExternalFunction()
      * which uses the actual parameter list to estimate a functional type
      */
     pips_assert("Parameter type list should be empty",
                 ENDP(functional_parameters(ft)));
  
     for (pc = l; pc != NULL; pc = CDR(pc)) {
         entity fp = ENTITY(CAR(pc));
         type fpt = entity_type(fp);
  
         if(type_undefined_p(fpt)) {
             entity_type(fp) = ImplicitType(fp);
         }
  
         p = make_parameter((entity_type(fp)),
                            (MakeModeReference()), make_dummy_identifier(fp));
         functional_parameters(ft) =
                 gen_nconc(functional_parameters(ft),
                           CONS(PARAMETER, p, NIL));
     }
  
     ifdebug(8) {
         pips_debug(8, "End for %s with type ",
               module_local_name(CurrentFunction));
         fprint_functional(stderr, type_functional(t));
         (void) fprintf(stderr, "\n");
     }
 }

References CAR, CDR, CONS, ENDP, ENTITY, entity_type, f(), fprint_functional(), fprintf(), functional_parameters, gen_nconc(), ifdebug, ImplicitType(), make_dummy_identifier(), make_parameter(), MakeModeReference(), module_local_name(), NIL, PARAMETER, pips_assert, pips_debug, type_functional, type_functional_p, and type_undefined_p.

Referenced by EndOfProcedure(), gfc2pips_namespace(), gfc2pips_parameters(), and MakeEntry().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ uses_alternate_return()

void uses_alternate_return ( bool use )

Parameters

use se

Definition at line 171 of file return.c.

 {
   if(use && strcmp(get_string_property("PARSER_SUBSTITUTE_ALTERNATE_RETURNS"), "NO")==0) {
     pips_user_warning
       ("Lines %d-%d: Alternate return not processed with current option \"%s\". "
        "Formal label * ignored.\n"
        "See property PARSER_SUBSTITUTE_ALTERNATE_RETURNS for other options\n",
        line_b_I, line_e_I, get_string_property("PARSER_SUBSTITUTE_ALTERNATE_RETURNS"));
     ParserError("uses_alternate_return", "Alternate returns prohibited by user\n");
   }
  
   current_number_of_alternate_returns++;
  
   current_module_uses_alternate_returns = use;
 }

References current_module_uses_alternate_returns, current_number_of_alternate_returns, get_string_property(), line_b_I, line_e_I, ParserError(), and pips_user_warning.

Referenced by EndOfProcedure(), and ParserError().

Here is the call graph for this function:

Here is the caller graph for this function:

◆ uses_alternate_return_p()

bool uses_alternate_return_p ( void )

Definition at line 166 of file return.c.

 {
     return current_module_uses_alternate_returns;
 }

References current_module_uses_alternate_returns.

Referenced by add_formal_return_code(), GenerateReturn(), and MakeReturn().

Here is the caller graph for this function:

◆ ValueOfIthLowerBound()

int ValueOfIthLowerBound	(	entity	e,
		int	i
	)

this function returns the size of the ith lower bound of a variable e.

Definition at line 1591 of file declaration.c.

 {
     cons * pc;
  
     pips_assert("ValueOfIthLowerBound", type_variable_p(entity_type(e)));
  
     pips_assert("ValueOfIthLowerBound", i >= 1 && i <= 7);
  
     pc = variable_dimensions(type_variable(entity_type(e)));
  
     while (pc != NULL && --i > 0)
             pc = CDR(pc);
  
     if (pc == NULL)
         ParserError("SizeOfIthLowerBound", "not enough dimensions\n");
  
     return(ExpressionToInt((dimension_lower(DIMENSION(CAR(pc))))));
 }

References CAR, CDR, DIMENSION, dimension_lower, entity_type, ExpressionToInt(), ParserError(), pips_assert, type_variable, type_variable_p, and variable_dimensions.

Referenced by OffsetOfReference().

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

◆ AllocatableArea

entity AllocatableArea

extern

Definition at line 61 of file area.c.

◆ Comm

char* Comm

extern

reader.c

Definition at line 152 of file reader.c.

Referenced by init_comment_buffers(), ReadLine(), and resize_comment_buffers().

◆ CurrComm

char* CurrComm

extern

Definition at line 152 of file reader.c.

Referenced by init_comment_buffers(), ReadLine(), and resize_comment_buffers().

◆ CurrentFN

char* CurrentFN

extern

parser.c

name of the current file

Definition at line 49 of file parser.c.

Referenced by check_first_statement(), dump_current_statement(), ParserError(), and the_actual_parser().

◆ CurrentPackage

const char* CurrentPackage

extern

the name of the current package, i.e.

TOP-LEVEL or a module name?

Definition at line 58 of file parser.c.

Referenced by BeginingOfParsing(), EndOfProcedure(), get_use_entities_list(), gfc2pips_add_to_callees(), gfc2pips_check_entity_doesnt_exists(), gfc2pips_check_entity_exists(), gfc2pips_expr2entity(), gfc2pips_expr2expression(), gfc2pips_exprIO3(), gfc2pips_getTypesDeclared(), gfc2pips_int2label(), gfc2pips_namespace(), gfc2pips_parameters(), gfc2pips_symbol2entity(), gfc2pips_vars_(), InitAreas(), MakeCurrentFunction(), MakeLabel(), NameToFunctionalEntity(), ParserError(), and update_common_sizes().

◆ CurrentType

type CurrentType

extern

to count control specifications in IO statements

Definition at line 101 of file syn_yacc.c.

◆ CurrentTypeSize

intptr_t CurrentTypeSize

extern

the type in a type or dimension or common statement

Definition at line 103 of file syn_yacc.c.

◆ DynamicArea

entity DynamicArea

extern

These global variables are declared in ri-util/util.c.

area.c

These global variables are declared in ri-util/util.c.

functions for areas Four areas used to allocate variables which are not stored in a Fortran common. These areas are just like Fortran commons, but the dynamic area is the only non-static area according to Fortran standard. The heap and the stack area are used to deal with Fortran ANSI extensions and C, pointers and allocatable arrays, and adjustable arrays (VLA in C). The dynamic area is stack allocated by most compilers but could be statically allocated since the array sizes are known.

Areas are declared for each module. These four global variables are managed by the Fortran and C parsers and used to allocate variables in the current module. Note that the C parser uses more areas at the same time to cope with global variables.

Definition at line 57 of file area.c.

◆ FormalParameters

cons* FormalParameters

extern

the current function

entity CurrentFunction; list of formal parameters of the current function

Definition at line 55 of file parser.c.

Referenced by EndOfProcedure(), and ScanFormalParameters().

◆ FormatValue

char FormatValue[(4096)]

extern

a string that will contain the value of the format in case of format statement

Definition at line 95 of file parser.c.

◆ HeapArea

entity HeapArea

extern

Definition at line 59 of file area.c.

Referenced by print_common_layout().

◆ ici

int ici

extern

syn_yacc.c

Definition at line 100 of file syn_yacc.c.

◆ iComm

int iComm

extern

Definition at line 153 of file reader.c.

Referenced by parser_reset_all_reader_buffers(), and ReadLine().

◆ iCurrComm

int iCurrComm

extern

Definition at line 153 of file reader.c.

Referenced by parser_reset_all_reader_buffers(), and ReadLine().

◆ InParserError

bool InParserError

extern

Parser error handling.

Definition at line 113 of file parser.c.

Referenced by ParserError().

◆ iPrevComm

int iPrevComm

extern

Definition at line 153 of file reader.c.

Referenced by LinkInstToCurrentBlock(), MakeDataStatement(), MakeElseInst(), MakeEndifInst(), parser_reset_all_reader_buffers(), and ReadLine().

◆ lab_I

char lab_I[6]

extern

Definition at line 69 of file parser.c.

Referenced by empty_current_label_string_p(), EndOfProcedure(), GenerateReturn(), get_current_label_string(), LinkInstToCurrentBlock(), MakeEnddoInst(), reset_current_label_string(), and set_current_label_string().

◆ line_b_C

int line_b_C

extern

Definition at line 68 of file parser.c.

Referenced by check_first_statement(), ReadStmt(), and set_first_format_statement().

◆ line_b_I

int line_b_I

extern

Indicates where the current instruction (in fact statement) starts and ends in the input file and gives its label.

Temporary versions of these variables are used because of the pipeline existing between the reader and the actual parser. The names of the temporary variables are prefixed with "tmp_". The default and reset values of these variables and their temporary versions (declared in reader.c) must be consistent.

Definition at line 68 of file parser.c.

Referenced by add_alternate_return(), AddVariableToCommon(), check_first_statement(), DeclarePointer(), DeclareVariable(), fix_if_condition(), implied_do_reference_number(), MakeReturn(), MakeWhileDoInst(), ParserError(), set_first_format_statement(), update_functional_type_with_actual_arguments(), and uses_alternate_return().

◆ line_e_C

int line_e_C

extern

Definition at line 68 of file parser.c.

Referenced by ReadStmt().

◆ line_e_I

int line_e_I

extern

Definition at line 68 of file parser.c.

Referenced by add_alternate_return(), AddVariableToCommon(), DeclarePointer(), DeclareVariable(), dump_current_statement(), fix_if_condition(), implied_do_reference_number(), MakeReturn(), MakeWhileDoInst(), ParserError(), ReadStmt(), update_functional_type_with_actual_arguments(), and uses_alternate_return().

◆ PrevComm

char* PrevComm

extern

Definition at line 152 of file reader.c.

Referenced by init_comment_buffers(), LinkInstToCurrentBlock(), MakeDataStatement(), ReadLine(), and resize_comment_buffers().

◆ StackArea

entity StackArea

extern

Definition at line 60 of file area.c.

Referenced by print_common_layout().

◆ StaticArea

entity StaticArea

extern

Definition at line 58 of file area.c.

◆ syn__flex_debug

int syn__flex_debug

extern

◆ syn_char

int syn_char

extern

◆ syn_in

FILE* syn_in

extern

lex yacc interface

Definition at line 325 of file syntax.h.

◆ syn_leng

int syn_leng

extern

scanner.c

◆ syn_lineno

int syn_lineno

extern

◆ syn_nerrs

int syn_nerrs

extern

◆ syn_out

FILE* syn_out

extern

◆ syn_text

char* syn_text

extern

◆ vcid_syntax_equivalence

char vcid_syntax_equivalence[]

extern

equivalence.c

Allocate addresses in commons and in the static area and in the dynamic area. The heap area is left aside.

Definition at line 33 of file equivalence.c.

◆ vcid_syntax_expression

char vcid_syntax_expression[]

extern

expression.c

Definition at line 29 of file expression.c.

Macros

Functions

Variables

Macro Definition Documentation

◆ abs

◆ FatalError

◆ FORMATLENGTH

◆ HASH_SIZE

◆ LOCAL

◆ START_COMMENT_LINE

◆ Warning

Function Documentation

◆ AbortEntries()

◆ AbortOfProcedure()

◆ add_actual_return_code()

◆ add_alternate_return()

◆ add_entity_to_declarations()

◆ add_formal_return_code()

◆ add_ghost_variable_entity()

◆ AddEffectiveFormalParameter()

◆ AddEntryEntity()

◆ AddEntryLabel()

◆ AddEntryTarget()

◆ AddOrMergeChain()

◆ AddVariableToCommon()

◆ AnalyzeData()

◆ append_data_current_stmt_buffer_to_declarations()

◆ BeginingOfParsing()

◆ BeginingOfProcedure()

◆ CapitalizeStmt()

◆ ChainIntersection()

◆ check_first_statement()

◆ check_in_declarations()

◆ CheckAndInitializeStmt()

◆ CheckLeftHandSide()

◆ CheckParenthesis()

◆ common_to_defined_size_p()

◆ common_to_size()

◆ ComputeAddresses()

◆ ComputeEquivalences()

◆ cr_implicit()

◆ CurrentOffsetOfArea()

◆ DeclareExternalFunction()

◆ DeclareIntrinsic()

◆ DeclarePointer()

◆ DeclareVariable()

◆ dump_current_statement()

◆ empty_current_label_string_p()

◆ EmptyEntryListsP()

◆ EndOfProcedure()

◆ entity_in_equivalence_chain_p()

◆ entity_in_equivalence_chains_p()

◆ FindAssign()

◆ FindAutre()

◆ FindDo()

◆ FindDoWhile()

◆ FindIf()

◆ FindIfArith()

◆ FindImplicit()

◆ FindMatchingPar()

◆ FindPoints()

◆ FindProfZero()

◆ first_executable_statement_seen()

◆ first_format_statement_seen()

◆ fix_if_condition()

◆ fortran_relevant_area_entity_p()

◆ FortranExpressionList()

◆ generate_return_code_checks()

◆ GenerateReturn()

◆ get_alternate_returns()

◆ get_current_label_string()

◆ get_current_number_of_alternate_returns()

◆ get_statement_number()

◆ GetChar()

◆ GetReturnCodeVariable()

◆ ghost_variable_entity_p()

◆ hpfc_parser()

◆ implicit_type_p()

◆ ImplicitType()

◆ init_ghost_variable_entities()