version 1.1, 2010/01/26 15:22:45
|
version 1.36, 2011/06/22 13:27:04
|
Line 1
|
Line 1
|
/* |
/* |
================================================================================ |
================================================================================ |
RPL/2 (R) version 4.0.9 |
RPL/2 (R) version 4.1.0.prerelease.3 |
Copyright (C) 1989-2010 Dr. BERTRAND Joël |
Copyright (C) 1989-2011 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" |
|
|
|
|
/* |
/* |
================================================================================ |
================================================================================ |
Boucle principale de l'interpréteur RPL/2 |
Boucle principale de l'interprète RPL/2 |
================================================================================ |
================================================================================ |
Entrées : structure sur l'état du processus |
Entrées : structure sur l'état du processus |
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
Line 41 sequenceur(struct_processus *s_etat_proc
|
Line 41 sequenceur(struct_processus *s_etat_proc
|
struct_liste_chainee *l_element_courant; |
struct_liste_chainee *l_element_courant; |
|
|
struct_objet *s_objet; |
struct_objet *s_objet; |
|
struct_objet *s_objet_evaluation; |
struct_objet *s_sous_objet; |
struct_objet *s_sous_objet; |
|
|
logical1 drapeau_appel_definition; |
logical1 drapeau_appel_definition; |
Line 103 sequenceur(struct_processus *s_etat_proc
|
Line 104 sequenceur(struct_processus *s_etat_proc
|
|
|
/* |
/* |
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
Boucle de l'interpréteur RPL/2 |
Boucle de l'interprète RPL/2 |
On boucle tant qu'on n'a pas une bonne raison de sortir... |
On boucle tant qu'on n'a pas une bonne raison de sortir... |
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
Line 198 sequenceur(struct_processus *s_etat_proc
|
Line 199 sequenceur(struct_processus *s_etat_proc
|
(*s_etat_processus).localisation, d_locale)) |
(*s_etat_processus).localisation, d_locale)) |
== NULL) |
== NULL) |
{ |
{ |
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
Line 282 sequenceur(struct_processus *s_etat_proc
|
Line 284 sequenceur(struct_processus *s_etat_proc
|
|
|
tampon = (*s_etat_processus).instruction_courante; |
tampon = (*s_etat_processus).instruction_courante; |
(*s_etat_processus).instruction_courante = ligne; |
(*s_etat_processus).instruction_courante = ligne; |
|
|
recherche_type(s_etat_processus); |
recherche_type(s_etat_processus); |
|
|
|
(*s_etat_processus).instruction_courante = tampon; |
|
|
if ((((*s_etat_processus).erreur_execution != d_ex) || |
if ((((*s_etat_processus).erreur_execution != d_ex) || |
((*s_etat_processus).erreur_systeme != d_es)) && |
((*s_etat_processus).erreur_systeme != d_es)) && |
((*s_etat_processus).invalidation_message_erreur |
((*s_etat_processus).invalidation_message_erreur |
Line 301 sequenceur(struct_processus *s_etat_proc
|
Line 306 sequenceur(struct_processus *s_etat_proc
|
|
|
if ((message = messages(s_etat_processus)) == NULL) |
if ((message = messages(s_etat_processus)) == NULL) |
{ |
{ |
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
Line 360 sequenceur(struct_processus *s_etat_proc
|
Line 366 sequenceur(struct_processus *s_etat_proc
|
if ((message = messages(s_etat_processus)) |
if ((message = messages(s_etat_processus)) |
== NULL) |
== NULL) |
{ |
{ |
|
free((*s_etat_processus) |
|
.instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
printf("%s [%d]\n", message, (int) getpid()); |
printf("%s [%d]\n", message, (int) getpid()); |
free(message); |
|
|
|
|
free(message); |
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
else if ((*s_etat_processus) |
else if ((*s_etat_processus) |
Line 383 sequenceur(struct_processus *s_etat_proc
|
Line 392 sequenceur(struct_processus *s_etat_proc
|
if ((message = messages(s_etat_processus)) |
if ((message = messages(s_etat_processus)) |
== NULL) |
== NULL) |
{ |
{ |
|
free((*s_etat_processus) |
|
.instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
Line 433 sequenceur(struct_processus *s_etat_proc
|
Line 444 sequenceur(struct_processus *s_etat_proc
|
(*(*s_etat_processus).l_base_pile_systeme) |
(*(*s_etat_processus).l_base_pile_systeme) |
.retour_definition = tampon_retour; |
.retour_definition = tampon_retour; |
} |
} |
|
|
(*s_etat_processus).instruction_courante = tampon; |
|
} |
} |
else if ((*s_etat_processus).invalidation_message_erreur |
else if ((*s_etat_processus).invalidation_message_erreur |
== d_faux) |
== d_faux) |
Line 450 sequenceur(struct_processus *s_etat_proc
|
Line 459 sequenceur(struct_processus *s_etat_proc
|
|
|
if ((message = messages(s_etat_processus)) == NULL) |
if ((message = messages(s_etat_processus)) == NULL) |
{ |
{ |
|
free((*s_etat_processus).instruction_courante); |
free(ligne); |
free(ligne); |
return(d_erreur); |
return(d_erreur); |
} |
} |
Line 497 sequenceur(struct_processus *s_etat_proc
|
Line 507 sequenceur(struct_processus *s_etat_proc
|
/* |
/* |
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
Dans le cas où une instruction est retournée, celle-ci est évaluée. Dans le |
Dans le cas où une instruction est retournée, celle-ci est évaluée. Dans le |
cas contraire, l'interpréteur renvoie un message d'erreur et s'interrompt. |
cas contraire, l'interprète renvoie un message d'erreur et s'interrompt. |
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
Line 545 sequenceur(struct_processus *s_etat_proc
|
Line 555 sequenceur(struct_processus *s_etat_proc
|
d_vrai) && ((*s_etat_processus) |
d_vrai) && ((*s_etat_processus) |
.autorisation_evaluation_nom == 'Y')) |
.autorisation_evaluation_nom == 'Y')) |
{ |
{ |
if (((*s_etat_processus).s_liste_variables |
if ((*(*s_etat_processus).pointeur_variable_courante) |
[(*s_etat_processus) |
.objet == NULL) |
.position_variable_courante]).objet == NULL) |
|
{ |
{ |
|
|
/* |
/* |
Line 564 sequenceur(struct_processus *s_etat_proc
|
Line 573 sequenceur(struct_processus *s_etat_proc
|
{ |
{ |
printf("[%d] Empilement de la variable " |
printf("[%d] Empilement de la variable " |
"partagée %s de type %d\n", |
"partagée %s de type %d\n", |
(int) getpid(), |
(int) getpid(), (*s_etat_processus) |
(*s_etat_processus) |
|
.instruction_courante, |
.instruction_courante, |
(*((*s_etat_processus).s_liste_variables |
(*(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante).objet) |
.position_variable_courante]).objet) |
|
.type); |
.type); |
} |
} |
else |
else |
Line 578 sequenceur(struct_processus *s_etat_proc
|
Line 585 sequenceur(struct_processus *s_etat_proc
|
"variable \n", (int) getpid(), |
"variable \n", (int) getpid(), |
(*s_etat_processus) |
(*s_etat_processus) |
.instruction_courante, |
.instruction_courante, |
(*((*s_etat_processus).s_liste_variables |
(*(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante).objet) |
.position_variable_courante]).objet) |
|
.type); |
.type); |
} |
} |
|
|
Line 596 sequenceur(struct_processus *s_etat_proc
|
Line 602 sequenceur(struct_processus *s_etat_proc
|
} |
} |
|
|
if (recherche_variable_partagee(s_etat_processus, |
if (recherche_variable_partagee(s_etat_processus, |
((*s_etat_processus).s_liste_variables |
(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante).nom, |
.position_variable_courante]).nom, |
(*(*s_etat_processus) |
((*s_etat_processus).s_liste_variables |
.pointeur_variable_courante).variable_partagee, |
[(*s_etat_processus) |
'P') == d_vrai) |
.position_variable_courante]) |
|
.variable_partagee, 'P') == d_vrai) |
|
{ |
{ |
// La variable existe. |
// La variable existe. |
|
|
Line 662 sequenceur(struct_processus *s_etat_proc
|
Line 666 sequenceur(struct_processus *s_etat_proc
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
else if ((*((*s_etat_processus).s_liste_variables |
else if ((*(*(*s_etat_processus).pointeur_variable_courante) |
[(*s_etat_processus).position_variable_courante]) |
|
.objet).type == ADR) |
.objet).type == ADR) |
{ |
{ |
|
|
Line 732 sequenceur(struct_processus *s_etat_proc
|
Line 735 sequenceur(struct_processus *s_etat_proc
|
|
|
(*s_etat_processus).position_courante = |
(*s_etat_processus).position_courante = |
(*((unsigned long *) |
(*((unsigned long *) |
((*((*s_etat_processus).s_liste_variables |
((*(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante) |
.position_variable_courante] |
.objet).objet))); |
.objet)).objet))); |
|
|
|
drapeau_appel_definition = d_vrai; |
drapeau_appel_definition = d_vrai; |
} |
} |
Line 753 sequenceur(struct_processus *s_etat_proc
|
Line 755 sequenceur(struct_processus *s_etat_proc
|
(int) getpid(), |
(int) getpid(), |
(*s_etat_processus) |
(*s_etat_processus) |
.instruction_courante, |
.instruction_courante, |
(*((*s_etat_processus).s_liste_variables |
(*(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante).objet) |
.position_variable_courante]).objet) |
|
.type); |
.type); |
} |
} |
else |
else |
Line 764 sequenceur(struct_processus *s_etat_proc
|
Line 765 sequenceur(struct_processus *s_etat_proc
|
"\n", (int) getpid(), |
"\n", (int) getpid(), |
(*s_etat_processus) |
(*s_etat_processus) |
.instruction_courante, |
.instruction_courante, |
(*((*s_etat_processus).s_liste_variables |
(*(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante).objet) |
.position_variable_courante]).objet) |
|
.type); |
.type); |
} |
} |
|
|
Line 774 sequenceur(struct_processus *s_etat_proc
|
Line 774 sequenceur(struct_processus *s_etat_proc
|
} |
} |
|
|
if ((s_objet = copie_objet(s_etat_processus, |
if ((s_objet = copie_objet(s_etat_processus, |
((*s_etat_processus) |
(*(*s_etat_processus) |
.s_liste_variables[(*s_etat_processus) |
.pointeur_variable_courante).objet, 'P')) |
.position_variable_courante]).objet, 'P')) |
|
== NULL) |
== NULL) |
{ |
{ |
(*s_etat_processus).erreur_systeme = |
(*s_etat_processus).erreur_systeme = |
Line 805 sequenceur(struct_processus *s_etat_proc
|
Line 804 sequenceur(struct_processus *s_etat_proc
|
|
|
(*s_etat_processus).erreur_systeme = d_es; |
(*s_etat_processus).erreur_systeme = d_es; |
recherche_type(s_etat_processus); |
recherche_type(s_etat_processus); |
|
|
|
if ((*s_etat_processus).autorisation_nom_implicite == 'N') |
|
{ |
|
if ((*s_etat_processus).l_base_pile == NULL) |
|
{ |
|
(*s_etat_processus).erreur_execution = |
|
d_ex_manque_argument; |
|
} |
|
else if ((*(*(*s_etat_processus).l_base_pile).donnee) |
|
.type == NOM) |
|
{ |
|
if ((*((struct_nom *) (*(*(*s_etat_processus) |
|
.l_base_pile).donnee).objet)).symbole |
|
== d_faux) |
|
{ |
|
(*s_etat_processus).erreur_execution = |
|
d_ex_nom_implicite; |
|
|
|
// Si le niveau de récursivité est non nul, on |
|
// arrive ici depuis la fonction |
|
// recherche_type(). On retourne à cette |
|
// dernière en indiquant une erreur. |
|
|
|
if ((*s_etat_processus).niveau_recursivite != 0) |
|
{ |
|
free((*s_etat_processus) |
|
.instruction_courante); |
|
return(d_erreur); |
|
} |
|
} |
|
} |
|
} |
|
|
|
// Le séquenceur est appelé depuis la routine d'évaluation |
|
|
|
if ((*s_etat_processus).evaluation_forcee == 'Y') |
|
{ |
|
if (depilement(s_etat_processus, |
|
&((*s_etat_processus).l_base_pile), |
|
&s_objet_evaluation) == d_erreur) |
|
{ |
|
free((*s_etat_processus).instruction_courante); |
|
(*s_etat_processus).erreur_execution = |
|
d_ex_manque_argument; |
|
return(d_erreur); |
|
} |
|
|
|
if (evaluation(s_etat_processus, s_objet_evaluation, |
|
'N') == d_erreur) |
|
{ |
|
free((*s_etat_processus).instruction_courante); |
|
liberation(s_etat_processus, s_objet_evaluation); |
|
return(d_erreur); |
|
} |
|
|
|
liberation(s_etat_processus, s_objet_evaluation); |
|
} |
|
|
|
// Le séquenceur est appelé depuis la routine de |
|
// recherche de type |
|
|
|
else if ((*s_etat_processus).recherche_type == 'Y') |
|
{ |
|
if ((*s_etat_processus).erreur_execution != d_ex) |
|
{ |
|
free((*s_etat_processus).instruction_courante); |
|
return(d_erreur); |
|
} |
|
} |
} |
} |
} |
} |
else if (((*s_etat_processus).test_instruction == 'Y') && |
else if (((*s_etat_processus).test_instruction == 'Y') && |
Line 829 sequenceur(struct_processus *s_etat_proc
|
Line 897 sequenceur(struct_processus *s_etat_proc
|
!= 0) && (strcmp((*s_etat_processus) |
!= 0) && (strcmp((*s_etat_processus) |
.instruction_courante, ">>") != 0)) |
.instruction_courante, ">>") != 0)) |
{ |
{ |
if ((s_objet = (struct_objet *) malloc( |
if ((s_objet = allocation(s_etat_processus, FCT)) == NULL) |
sizeof(struct_objet))) == NULL) |
|
{ |
|
(*s_etat_processus).erreur_systeme = |
|
d_es_allocation_memoire; |
|
return(d_erreur); |
|
} |
|
|
|
initialisation_objet(s_objet); |
|
(*s_objet).type = FCT; |
|
|
|
if (((*s_objet).objet = allocation(s_etat_processus, FCT)) |
|
== NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = |
(*s_etat_processus).erreur_systeme = |
d_es_allocation_memoire; |
d_es_allocation_memoire; |
Line 924 sequenceur(struct_processus *s_etat_proc
|
Line 980 sequenceur(struct_processus *s_etat_proc
|
|
|
fflush(stdout); |
fflush(stdout); |
|
|
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
Line 1005 sequenceur(struct_processus *s_etat_proc
|
Line 1062 sequenceur(struct_processus *s_etat_proc
|
|
|
if ((message = messages(s_etat_processus)) == NULL) |
if ((message = messages(s_etat_processus)) == NULL) |
{ |
{ |
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
Line 1091 sequenceur(struct_processus *s_etat_proc
|
Line 1149 sequenceur(struct_processus *s_etat_proc
|
|
|
if (erreur == d_erreur) |
if (erreur == d_erreur) |
{ |
{ |
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
if (recherche_variable(s_etat_processus, |
if (recherche_variable(s_etat_processus, |
(*s_etat_processus).instruction_courante) == d_vrai) |
(*s_etat_processus).instruction_courante) == d_vrai) |
{ |
{ |
if (((*s_etat_processus).s_liste_variables |
if ((*(*s_etat_processus).pointeur_variable_courante) |
[(*s_etat_processus) |
.objet == NULL) |
.position_variable_courante]).objet == NULL) |
|
{ |
{ |
// Variable partagée |
// Variable partagée |
} |
} |
else if ((*((*s_etat_processus).s_liste_variables |
else if ((*(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante).objet).type == ADR) |
.position_variable_courante]).objet).type == |
|
ADR) |
|
{ |
{ |
empilement_pile_systeme(s_etat_processus); |
empilement_pile_systeme(s_etat_processus); |
|
|
if ((*s_etat_processus).erreur_systeme != d_es) |
if ((*s_etat_processus).erreur_systeme != d_es) |
{ |
{ |
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|
Line 1128 sequenceur(struct_processus *s_etat_proc
|
Line 1185 sequenceur(struct_processus *s_etat_proc
|
|
|
(*s_etat_processus).position_courante = |
(*s_etat_processus).position_courante = |
(*((unsigned long *) |
(*((unsigned long *) |
((*((*s_etat_processus).s_liste_variables |
((*(*(*s_etat_processus) |
[(*s_etat_processus) |
.pointeur_variable_courante) |
.position_variable_courante] |
.objet).objet))); |
.objet)).objet))); |
|
|
|
(*s_etat_processus) |
(*s_etat_processus) |
.autorisation_empilement_programme = 'N'; |
.autorisation_empilement_programme = 'N'; |
Line 1145 sequenceur(struct_processus *s_etat_proc
|
Line 1201 sequenceur(struct_processus *s_etat_proc
|
|
|
if (instruction_majuscule == NULL) |
if (instruction_majuscule == NULL) |
{ |
{ |
|
free((*s_etat_processus).instruction_courante); |
return(d_erreur); |
return(d_erreur); |
} |
} |
|
|