rpl/src/instructions_f1.c - diff

Return to instructions_f1.c CVS log

Up to [local] / rpl / src

Diff for /rpl/src/instructions_f1.c between versions 1.2 and 1.73

version 1.2, 2010/01/27 22:22:13	version 1.73, 2015/11/26 11:44:35
Line 1	Line 1
/*	/*
================================================================================	================================================================================
RPL/2 (R) version 4.0.10	RPL/2 (R) version 4.1.24
Copyright (C) 1989-2010 Dr. BERTRAND Joël	Copyright (C) 1989-2015 Dr. BERTRAND Joël

This file is part of RPL/2.	This file is part of RPL/2.

Line 20	Line 20
*/	*/


#include "rpl.conv.h"	#include "rpl-conv.h"


/*	/*
Line 53 instruction_fleche(struct_processus *s_e	Line 53 instruction_fleche(struct_processus *s_e
logical1 fin_scrutation;	logical1 fin_scrutation;
logical1 presence_expression_algebrique;	logical1 presence_expression_algebrique;

	pthread_mutexattr_t attributs_mutex;

union_position_variable position_variable;	union_position_variable position_variable;

unsigned char instruction_valide;	unsigned char instruction_valide;
unsigned char *tampon;	unsigned char *tampon;
unsigned char test_instruction;	unsigned char test_instruction;

unsigned long i;	integer8 i;
unsigned long nombre_variables;	integer8 nombre_variables;

void (*fonction)();	void (*fonction)();

Line 108 instruction_fleche(struct_processus *s_e	Line 110 instruction_fleche(struct_processus *s_e

printf(" -> (variables) %s\n\n", d_RPN);	printf(" -> (variables) %s\n\n", d_RPN);

printf(" -> (variables) %s\n", d_ALG);	printf(" -> (variables) %s\n\n", d_ALG);

	printf(" -> (variables) %s\n", d_NOM);

return;	return;
}	}
Line 187 instruction_fleche(struct_processus *s_e	Line 191 instruction_fleche(struct_processus *s_e

if ((*s_etat_processus).instruction_valide == 'N')	if ((*s_etat_processus).instruction_valide == 'N')
{	{
	(*s_etat_processus).type_en_cours = NON;
recherche_type(s_etat_processus);	recherche_type(s_etat_processus);

if ((*s_etat_processus).erreur_execution != d_ex)	if ((*s_etat_processus).erreur_execution != d_ex)
Line 221 instruction_fleche(struct_processus *s_e	Line 226 instruction_fleche(struct_processus *s_e
else if ((((struct_nom ) (((*s_etat_processus).l_base_pile)	else if ((((struct_nom ) (((*s_etat_processus).l_base_pile)
.donnee).objet)).symbole == d_vrai)	.donnee).objet)).symbole == d_vrai)
{	{
(*s_etat_processus).erreur_execution = d_ex_nom_invalide;	(*s_etat_processus).niveau_courant++;
(*s_etat_processus).instruction_courante = tampon;	fin_scrutation = d_vrai;
return;	presence_expression_algebrique = d_vrai;

	if (depilement(s_etat_processus, &((*s_etat_processus)
	.l_base_pile), &s_expression_algebrique)
	== d_erreur)
	{
	(*s_etat_processus).erreur_execution =
	d_ex_manque_argument;
	(*s_etat_processus).instruction_courante = tampon;
	return;
	}
}	}
else	else
{	{
Line 271 instruction_fleche(struct_processus *s_e	Line 286 instruction_fleche(struct_processus *s_e
}	}
else	else
{	{
	(*s_etat_processus).expression_courante = l_element_courant;
(*s_etat_processus).erreur_execution = d_ex_nom_invalide;	(*s_etat_processus).erreur_execution = d_ex_nom_invalide;
return;	return;
}	}
Line 285 instruction_fleche(struct_processus *s_e	Line 301 instruction_fleche(struct_processus *s_e
}	}
else if (((l_element_courant).donnee).type != NOM)	else if (((l_element_courant).donnee).type != NOM)
{	{
	(*s_etat_processus).expression_courante = l_element_courant;
(*s_etat_processus).erreur_execution = d_ex_nom_invalide;	(*s_etat_processus).erreur_execution = d_ex_nom_invalide;
return;	return;
}	}
	else if ((((struct_nom ) ((l_element_courant).donnee).objet))
	.symbole == d_vrai)
	{
	(*s_etat_processus).niveau_courant++;
	fin_scrutation = d_vrai;
	presence_expression_algebrique = d_vrai;

	s_expression_algebrique = (*l_element_courant).donnee;
	}
else	else
{	{
if ((s_objet_elementaire = copie_objet(s_etat_processus,	if ((s_objet_elementaire = copie_objet(s_etat_processus,
(*l_element_courant).donnee, 'P')) == NULL)	(*l_element_courant).donnee, 'P')) == NULL)
{	{
	(*s_etat_processus).expression_courante = l_element_courant;
(*s_etat_processus).erreur_systeme =	(*s_etat_processus).erreur_systeme =
d_es_allocation_memoire;	d_es_allocation_memoire;
return;	return;
Line 301 instruction_fleche(struct_processus *s_e	Line 328 instruction_fleche(struct_processus *s_e
if (empilement(s_etat_processus, &((*s_etat_processus)	if (empilement(s_etat_processus, &((*s_etat_processus)
.l_base_pile), s_objet_elementaire) == d_erreur)	.l_base_pile), s_objet_elementaire) == d_erreur)
{	{
	(*s_etat_processus).expression_courante = l_element_courant;
return;	return;
}	}

Line 312 instruction_fleche(struct_processus *s_e	Line 340 instruction_fleche(struct_processus *s_e
l_element_courant = (*l_element_courant).suivant;	l_element_courant = (*l_element_courant).suivant;
} while((fin_scrutation == d_faux) && (l_element_courant != NULL));	} while((fin_scrutation == d_faux) && (l_element_courant != NULL));

	(*s_etat_processus).objet_courant =
	((s_etat_processus).expression_courante).donnee;
(*s_etat_processus).instruction_courante = tampon;	(*s_etat_processus).instruction_courante = tampon;

if (fin_scrutation == d_faux)	if (fin_scrutation == d_faux)
Line 333 instruction_fleche(struct_processus *s_e	Line 363 instruction_fleche(struct_processus *s_e
{	{
if ((*s_etat_processus).langue == 'F')	if ((*s_etat_processus).langue == 'F')
{	{
printf("[%d] Nombre de variables de niveau %lu : %lu\n",	printf("[%d] Nombre de variables de niveau %lld : %lld\n",
(int) getpid(),	(int) getpid(),
(*s_etat_processus).niveau_courant, nombre_variables);	(*s_etat_processus).niveau_courant, nombre_variables);
}	}
else	else
{	{
printf("[%d] Number of level %lu variables : %lu\n",	printf("[%d] Number of level %lld variables : %lld\n",
(int) getpid(),	(int) getpid(),
(*s_etat_processus).niveau_courant, nombre_variables);	(*s_etat_processus).niveau_courant, nombre_variables);
}	}
Line 351 instruction_fleche(struct_processus *s_e	Line 381 instruction_fleche(struct_processus *s_e

for(i = 0; i < nombre_variables; i++)	for(i = 0; i < nombre_variables; i++)
{	{
	if (l_emplacement_valeurs == NULL)
	{
	(*s_etat_processus).erreur_execution = d_ex_manque_argument;
	return;
	}

l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;	l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;
}	}

Line 416 instruction_fleche(struct_processus *s_e	Line 452 instruction_fleche(struct_processus *s_e
if (recherche_variable(s_etat_processus, s_variable.nom) == d_vrai)	if (recherche_variable(s_etat_processus, s_variable.nom) == d_vrai)
{	{
if ((*s_etat_processus).niveau_courant ==	if ((*s_etat_processus).niveau_courant ==
(s_etat_processus).s_liste_variables[(s_etat_processus)	((s_etat_processus).pointeur_variable_courante).niveau)
.position_variable_courante].niveau)
{	{
liberation(s_etat_processus, s_objet);	liberation(s_etat_processus, s_objet);
free(s_variable.nom);	free(s_variable.nom);
Line 446 instruction_fleche(struct_processus *s_e	Line 481 instruction_fleche(struct_processus *s_e
if (recherche_variable_statique(s_etat_processus, s_variable.nom,	if (recherche_variable_statique(s_etat_processus, s_variable.nom,
position_variable,	position_variable,
((*s_etat_processus).mode_execution_programme == 'Y')	((*s_etat_processus).mode_execution_programme == 'Y')
? 'P' : 'E') == d_vrai)	? 'P' : 'E') != NULL)
{	{
// Variable statique à utiliser	// Variable statique à utiliser

Line 459 instruction_fleche(struct_processus *s_e	Line 494 instruction_fleche(struct_processus *s_e
s_variable.origine = 'E';	s_variable.origine = 'E';
}	}

s_variable.objet = (*s_etat_processus)	s_variable.objet = ((s_etat_processus)
.s_liste_variables_statiques[(*s_etat_processus)	.pointeur_variable_statique_courante).objet;
.position_variable_statique_courante].objet;	((s_etat_processus).pointeur_variable_statique_courante)
(*s_etat_processus).s_liste_variables_statiques	.objet = NULL;
[(*s_etat_processus)
.position_variable_statique_courante].objet = NULL;
}	}
else	else
{	{
Line 540 instruction_fleche(struct_processus *s_e	Line 573 instruction_fleche(struct_processus *s_e
(*s_etat_processus).objet_courant;	(*s_etat_processus).objet_courant;
}	}

if (pthread_mutex_lock(&(((s_etat_processus)	if (pthread_mutex_lock(&mutex_creation_variable_partagee) != 0)
.s_liste_variables_partagees).mutex)) != 0)
{	{
(*s_etat_processus).erreur_systeme = d_es_processus;	(*s_etat_processus).erreur_systeme = d_es_processus;
return;	return;
Line 550 instruction_fleche(struct_processus *s_e	Line 582 instruction_fleche(struct_processus *s_e
if (recherche_variable_partagee(s_etat_processus, s_variable.nom,	if (recherche_variable_partagee(s_etat_processus, s_variable.nom,
position_variable,	position_variable,
((*s_etat_processus).mode_execution_programme == 'Y')	((*s_etat_processus).mode_execution_programme == 'Y')
? 'P' : 'E') == d_vrai)	? 'P' : 'E') != NULL)
{	{
// Variable partagée à utiliser	// Variable partagée à utiliser

	if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
	!= 0)
	{
	(*s_etat_processus).erreur_systeme = d_es_processus;
	return;
	}

if (pthread_mutex_unlock(&(((s_etat_processus)	if (pthread_mutex_unlock(&(((s_etat_processus)
.s_liste_variables_partagees).mutex)) != 0)	.pointeur_variable_partagee_courante).mutex)) != 0)
{	{
(*s_etat_processus).erreur_systeme = d_es_processus;	(*s_etat_processus).erreur_systeme = d_es_processus;
return;	return;
Line 578 instruction_fleche(struct_processus *s_e	Line 617 instruction_fleche(struct_processus *s_e
}	}
else	else
{	{
// Variable partagee à créer	// Variable partagée à créer

(*s_etat_processus).erreur_systeme = d_es;	(*s_etat_processus).erreur_systeme = d_es;

Line 625 instruction_fleche(struct_processus *s_e	Line 664 instruction_fleche(struct_processus *s_e
(*s_etat_processus).objet_courant;	(*s_etat_processus).objet_courant;
}	}

	// Création du mutex

	pthread_mutexattr_init(&attributs_mutex);
	pthread_mutexattr_settype(&attributs_mutex,
	PTHREAD_MUTEX_RECURSIVE);
	pthread_mutex_init(&(s_variable_partagee.mutex),
	&attributs_mutex);
	pthread_mutexattr_destroy(&attributs_mutex);

s_variable_partagee.objet = (*l_emplacement_valeurs).donnee;	s_variable_partagee.objet = (*l_emplacement_valeurs).donnee;
(*l_emplacement_valeurs).donnee = NULL;	(*l_emplacement_valeurs).donnee = NULL;

Line 634 instruction_fleche(struct_processus *s_e	Line 682 instruction_fleche(struct_processus *s_e
return;	return;
}	}

if (pthread_mutex_unlock(&(((s_etat_processus)	s_variable.objet = NULL;
.s_liste_variables_partagees).mutex)) != 0)
	if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
	!= 0)
{	{
(*s_etat_processus).erreur_systeme = d_es_processus;	(*s_etat_processus).erreur_systeme = d_es_processus;
return;	return;
}	}

s_variable.objet = NULL;
}	}
}	}
else	else
Line 700 instruction_fleche(struct_processus *s_e	Line 748 instruction_fleche(struct_processus *s_e

if (presence_expression_algebrique == d_vrai)	if (presence_expression_algebrique == d_vrai)
{	{
	// Si l'expression algébrique est réduite à un simple nom, il
	// s'agit toujours d'un nom symbolique. Il faut alors lui retirer
	// son caractère de constante symbolique pour faire remonter les
	// erreurs de type 'variable indéfinie'.

	if ((*s_expression_algebrique).type == NOM)
	{
	(((struct_nom ) (*s_expression_algebrique).objet)).symbole =
	d_faux;
	}

evaluation(s_etat_processus, s_expression_algebrique, 'N');	evaluation(s_etat_processus, s_expression_algebrique, 'N');

	if ((*s_expression_algebrique).type == NOM)
	{
	(((struct_nom ) (*s_expression_algebrique).objet)).symbole =
	d_vrai;
	}

if ((*s_etat_processus).mode_execution_programme == 'Y')	if ((*s_etat_processus).mode_execution_programme == 'Y')
{	{
liberation(s_etat_processus, s_expression_algebrique);	liberation(s_etat_processus, s_expression_algebrique);
}	}

	(*s_etat_processus).autorisation_empilement_programme = 'Y';
(*s_etat_processus).niveau_courant--;	(*s_etat_processus).niveau_courant--;

if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)	if (retrait_variables_par_niveau(s_etat_processus) == d_erreur)
{	{
return;	return;
}	}

(*s_etat_processus).autorisation_empilement_programme = 'Y';
}	}

return;	return;
Line 740 instruction_fleche_list(struct_processus	Line 804 instruction_fleche_list(struct_processus

struct_objet *s_objet;	struct_objet *s_objet;

signed long i;	integer8 i;
signed long nombre_elements;	integer8 nombre_elements;

(*s_etat_processus).erreur_execution = d_ex;	(*s_etat_processus).erreur_execution = d_ex;

Line 816 instruction_fleche_list(struct_processus	Line 880 instruction_fleche_list(struct_processus
return;	return;
}	}

if ((unsigned long) nombre_elements >=	if (nombre_elements >= (*s_etat_processus).hauteur_pile_operationnelle)
(*s_etat_processus).hauteur_pile_operationnelle)
{	{
(*s_etat_processus).erreur_execution = d_ex_manque_argument;	(*s_etat_processus).erreur_execution = d_ex_manque_argument;
return;	return;
Line 958 instruction_for(struct_processus *s_etat	Line 1021 instruction_for(struct_processus *s_etat
}	}
}	}

empilement_pile_systeme(s_etat_processus);

if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),	if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
&s_objet_1) == d_erreur)	&s_objet_1) == d_erreur)
{	{
Line 985 instruction_for(struct_processus *s_etat	Line 1046 instruction_for(struct_processus *s_etat
return;	return;
}	}

if (((*s_objet_2).type != INT) &&	if (((s_objet_2).type != INT) && ((s_objet_2).type != REL))
((*s_objet_2).type != REL))
{	{
liberation(s_etat_processus, s_objet_1);	liberation(s_etat_processus, s_objet_1);
liberation(s_etat_processus, s_objet_2);	liberation(s_etat_processus, s_objet_2);
Line 995 instruction_for(struct_processus *s_etat	Line 1055 instruction_for(struct_processus *s_etat
return;	return;
}	}

tampon = (*s_etat_processus).instruction_courante;	empilement_pile_systeme(s_etat_processus);
test_instruction = (*s_etat_processus).test_instruction;
instruction_valide = (*s_etat_processus).instruction_valide;	if ((*s_etat_processus).erreur_systeme != d_es)
(*s_etat_processus).test_instruction = 'Y';	{
	return;
	}

if ((*s_etat_processus).mode_execution_programme == 'Y')	if ((*s_etat_processus).mode_execution_programme == 'Y')
{	{
	tampon = (*s_etat_processus).instruction_courante;
	test_instruction = (*s_etat_processus).test_instruction;
	instruction_valide = (*s_etat_processus).instruction_valide;
	(*s_etat_processus).test_instruction = 'Y';

if (recherche_instruction_suivante(s_etat_processus) == d_erreur)	if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
{	{
return;	return;
Line 1016 instruction_for(struct_processus *s_etat	Line 1083 instruction_for(struct_processus *s_etat

free((*s_etat_processus).instruction_courante);	free((*s_etat_processus).instruction_courante);
(*s_etat_processus).instruction_courante = tampon;	(*s_etat_processus).instruction_courante = tampon;
	(*s_etat_processus).instruction_valide = instruction_valide;
	(*s_etat_processus).test_instruction = test_instruction;

	depilement_pile_systeme(s_etat_processus);

(*s_etat_processus).erreur_execution = d_ex_nom_reserve;	(*s_etat_processus).erreur_execution = d_ex_nom_reserve;
return;	return;
}	}

	(*s_etat_processus).type_en_cours = NON;
recherche_type(s_etat_processus);	recherche_type(s_etat_processus);

free((*s_etat_processus).instruction_courante);	free((*s_etat_processus).instruction_courante);
(*s_etat_processus).instruction_courante = tampon;	(*s_etat_processus).instruction_courante = tampon;
	(*s_etat_processus).instruction_valide = instruction_valide;
	(*s_etat_processus).test_instruction = test_instruction;

if ((*s_etat_processus).erreur_execution != d_ex)	if ((*s_etat_processus).erreur_execution != d_ex)
{	{
liberation(s_etat_processus, s_objet_1);	liberation(s_etat_processus, s_objet_1);
liberation(s_etat_processus, s_objet_2);	liberation(s_etat_processus, s_objet_2);

	depilement_pile_systeme(s_etat_processus);
return;	return;
}	}

Line 1040 instruction_for(struct_processus *s_etat	Line 1115 instruction_for(struct_processus *s_etat
liberation(s_etat_processus, s_objet_1);	liberation(s_etat_processus, s_objet_1);
liberation(s_etat_processus, s_objet_2);	liberation(s_etat_processus, s_objet_2);

	depilement_pile_systeme(s_etat_processus);

(*s_etat_processus).erreur_execution = d_ex_manque_argument;	(*s_etat_processus).erreur_execution = d_ex_manque_argument;
return;	return;
}	}
Line 1051 instruction_for(struct_processus *s_etat	Line 1128 instruction_for(struct_processus *s_etat
{	{
if ((*s_etat_processus).expression_courante == NULL)	if ((*s_etat_processus).expression_courante == NULL)
{	{
	depilement_pile_systeme(s_etat_processus);
(*s_etat_processus).erreur_execution = d_ex_manque_argument;	(*s_etat_processus).erreur_execution = d_ex_manque_argument;
return;	return;
}	}
Line 1075 instruction_for(struct_processus *s_etat	Line 1153 instruction_for(struct_processus *s_etat
liberation(s_etat_processus, s_objet_1);	liberation(s_etat_processus, s_objet_1);
liberation(s_etat_processus, s_objet_2);	liberation(s_etat_processus, s_objet_2);

	depilement_pile_systeme(s_etat_processus);

(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;	(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
return;	return;
}	}
Line 1083 instruction_for(struct_processus *s_etat	Line 1163 instruction_for(struct_processus *s_etat
liberation(s_etat_processus, s_objet_1);	liberation(s_etat_processus, s_objet_1);
liberation(s_etat_processus, s_objet_2);	liberation(s_etat_processus, s_objet_2);

	depilement_pile_systeme(s_etat_processus);

(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;	(*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
return;	return;
}	}
Line 1108 instruction_for(struct_processus *s_etat	Line 1190 instruction_for(struct_processus *s_etat

liberation(s_etat_processus, s_objet_3);	liberation(s_etat_processus, s_objet_3);

(*s_etat_processus).test_instruction = test_instruction;
(*s_etat_processus).instruction_valide = instruction_valide;

((s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;	((s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;

if ((*s_etat_processus).mode_execution_programme == 'Y')	if ((*s_etat_processus).mode_execution_programme == 'Y')
Line 1807 instruction_fact(struct_processus *s_eta	Line 1886 instruction_fact(struct_processus *s_eta
for (i = 1; i <= (((integer8 ) (*s_objet_argument).objet));	for (i = 1; i <= (((integer8 ) (*s_objet_argument).objet));
i++)	i++)
{	{
produit *= i;	produit *= (real8) i;
}	}

if ((s_objet_resultat = allocation(s_etat_processus, REL))	if ((s_objet_resultat = allocation(s_etat_processus, REL))
Line 2131 instruction_floor(struct_processus *s_et	Line 2210 instruction_floor(struct_processus *s_et
return;	return;
}	}

(((integer8 ) (*s_objet_resultat).objet)) =	(((integer8 ) (*s_objet_resultat).objet)) = (integer8)
floor((((real8 ) (*s_objet_argument).objet)));	floor((((real8 ) (*s_objet_argument).objet)));

if (!((((((integer8 ) (*s_objet_resultat).objet)) <	if (!((((((integer8 ) (*s_objet_resultat).objet)) <
Line 2763 instruction_fix(struct_processus *s_etat	Line 2842 instruction_fix(struct_processus *s_etat
return;	return;
}	}

(((logical8 ) (*s_objet).objet)) =	(((logical8 ) (*s_objet).objet)) = (logical8)
(((integer8 ) (*s_objet_argument).objet));	(((integer8 ) (*s_objet_argument).objet));

i43 = test_cfsf(s_etat_processus, 43);	i43 = test_cfsf(s_etat_processus, 43);
Line 2801 instruction_fix(struct_processus *s_etat	Line 2880 instruction_fix(struct_processus *s_etat
{	{
if (valeur_binaire[i] == '0')	if (valeur_binaire[i] == '0')
{	{
cf(s_etat_processus, j++);	cf(s_etat_processus, (unsigned char) j++);
}	}
else	else
{	{
sf(s_etat_processus, j++);	sf(s_etat_processus, (unsigned char) j++);
}	}
}	}

for(; j <= 56; cf(s_etat_processus, j++));	for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));

sf(s_etat_processus, 49);	sf(s_etat_processus, 49);
cf(s_etat_processus, 50);	cf(s_etat_processus, 50);

CVSweb interface <joel.bertrand@systella.fr>

Removed from v.1.2
changed lines
	Added in v.1.73