version 1.49, 2013/02/26 19:56:13
|
version 1.94, 2025/04/15 10:17:51
|
Line 1
|
Line 1
|
/* |
/* |
================================================================================ |
================================================================================ |
RPL/2 (R) version 4.1.12 |
RPL/2 (R) version 4.1.36 |
Copyright (C) 1989-2013 Dr. BERTRAND Joël |
Copyright (C) 1989-2025 Dr. BERTRAND Joël |
|
|
This file is part of RPL/2. |
This file is part of RPL/2. |
|
|
Line 39 static inline void
|
Line 39 static inline void
|
estimation_taille_pile_systeme(struct_processus *s_etat_processus) |
estimation_taille_pile_systeme(struct_processus *s_etat_processus) |
{ |
{ |
(*s_etat_processus).estimation_taille_pile_systeme_tampon = |
(*s_etat_processus).estimation_taille_pile_systeme_tampon = |
((*s_etat_processus).estimation_taille_pile_systeme_tampon * |
(((double) (*s_etat_processus) |
((double) 0.9)) + ((*s_etat_processus) |
.estimation_taille_pile_systeme_tampon) * |
.hauteur_pile_systeme * ((double) 0.1)); |
((double) 0.9)) + (((double) (*s_etat_processus) |
|
.hauteur_pile_systeme) * ((double) 0.1)); |
return; |
return; |
} |
} |
|
|
Line 130 empilement_pile_systeme(struct_processus
|
Line 131 empilement_pile_systeme(struct_processus
|
(*(*s_etat_processus).l_base_pile_systeme).type_cloture = ' '; |
(*(*s_etat_processus).l_base_pile_systeme).type_cloture = ' '; |
(*(*s_etat_processus).l_base_pile_systeme).clause = ' '; |
(*(*s_etat_processus).l_base_pile_systeme).clause = ' '; |
(*(*s_etat_processus).l_base_pile_systeme).adresse_retour = 0; |
(*(*s_etat_processus).l_base_pile_systeme).adresse_retour = 0; |
(*(*s_etat_processus).l_base_pile_systeme).niveau_courant = 0; |
(*(*s_etat_processus).l_base_pile_systeme).niveau_courant = |
(*(*s_etat_processus).l_base_pile_systeme).pointeur_adresse_retour = NULL; |
(*s_etat_processus).niveau_courant; |
(*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N'; |
(*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N'; |
(*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL; |
(*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL; |
(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = NULL; |
(*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = NULL; |
Line 148 empilement_pile_systeme(struct_processus
|
Line 149 empilement_pile_systeme(struct_processus
|
= (*s_etat_processus).creation_variables_partagees; |
= (*s_etat_processus).creation_variables_partagees; |
(*(*s_etat_processus).l_base_pile_systeme).evaluation_expression = |
(*(*s_etat_processus).l_base_pile_systeme).evaluation_expression = |
d_faux; |
d_faux; |
|
(*(*s_etat_processus).l_base_pile_systeme).debug_programme = |
|
(*s_etat_processus).debug_programme; |
|
|
(*s_etat_processus).erreur_systeme = d_es; |
(*s_etat_processus).erreur_systeme = d_es; |
(*s_etat_processus).creation_variables_statiques = d_faux; |
(*s_etat_processus).creation_variables_statiques = d_faux; |
(*s_etat_processus).creation_variables_partagees = d_faux; |
(*s_etat_processus).creation_variables_partagees = d_faux; |
|
(*s_etat_processus).debug_programme = d_faux; |
|
|
return; |
return; |
} |
} |
Line 222 depilement_pile_systeme(struct_processus
|
Line 226 depilement_pile_systeme(struct_processus
|
|
|
(*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste; |
(*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste; |
(*s_etat_processus).erreur_systeme = d_es; |
(*s_etat_processus).erreur_systeme = d_es; |
|
(*s_etat_processus).debug_programme = (*l_ancienne_base_liste) |
|
.debug_programme; |
|
|
// On positionne le drapeau de création des variables statiques. |
// On positionne le drapeau de création des variables statiques. |
|
|
Line 303 void
|
Line 309 void
|
trace(struct_processus *s_etat_processus, FILE *flux) |
trace(struct_processus *s_etat_processus, FILE *flux) |
{ |
{ |
integer8 i; |
integer8 i; |
|
integer8 j; |
integer8 candidat; |
integer8 candidat; |
|
integer8 candidat8; |
|
integer8 delta; |
|
integer8 nb_variables; |
|
|
long delta; |
struct_liste_chainee *l_element_expression; |
|
|
struct_liste_chainee *l_variable; |
|
struct_liste_chainee *l_candidat; |
|
|
|
struct_liste_pile_systeme *l_element_courant; |
struct_liste_pile_systeme *l_element_courant; |
|
|
|
struct_tableau_variables *tableau; |
|
|
unsigned char *tampon; |
unsigned char *tampon; |
|
|
l_element_courant = (*s_etat_processus).l_base_pile_systeme; |
l_element_courant = (*s_etat_processus).l_base_pile_systeme; |
Line 326 trace(struct_processus *s_etat_processus
|
Line 335 trace(struct_processus *s_etat_processus
|
l_element_courant = (*s_etat_processus).l_base_pile_systeme; |
l_element_courant = (*s_etat_processus).l_base_pile_systeme; |
flockfile(flux); |
flockfile(flux); |
|
|
|
nb_variables = nombre_variables(s_etat_processus); |
|
|
|
if ((tableau = malloc(((size_t) nb_variables) * |
|
sizeof(struct_tableau_variables))) == NULL) |
|
{ |
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
return; |
|
} |
|
|
|
liste_variables(s_etat_processus, tableau); |
|
|
if ((flux == stderr) || (flux == stdout)) |
if ((flux == stderr) || (flux == stdout)) |
{ |
{ |
fprintf(flux, "+++Backtrace\n"); |
fprintf(flux, "+++Backtrace\n"); |
Line 333 trace(struct_processus *s_etat_processus
|
Line 353 trace(struct_processus *s_etat_processus
|
|
|
while(l_element_courant != NULL) |
while(l_element_courant != NULL) |
{ |
{ |
fprintf(flux, "%d : (%016X) D=", i--, l_element_courant); |
fprintf(flux, "%lld : address # %016Xh\n", i--, l_element_courant); |
|
|
|
if ((*l_element_courant).creation_variables_statiques == d_vrai) |
|
{ |
|
fprintf(flux, " Variables = static\n"); |
|
} |
|
else if ((*l_element_courant).creation_variables_partagees == d_vrai) |
|
{ |
|
fprintf(flux, " Variables = shared\n"); |
|
} |
|
else |
|
{ |
|
fprintf(flux, " Variables = automatic\n"); |
|
} |
|
|
fprintf(flux, ((*l_element_courant).creation_variables_statiques |
if ((*l_element_courant).arret_si_exception == d_vrai) |
== d_vrai) ? "1" : "0"); |
{ |
fprintf(flux, ((*l_element_courant).creation_variables_partagees |
fprintf(flux, " In exception = abort\n"); |
== d_vrai) ? "1" : "0"); |
} |
fprintf(flux, ((*l_element_courant).arret_si_exception == d_vrai) |
else |
? "1" : "0"); |
{ |
fprintf(flux, ((*l_element_courant).evaluation_expression == d_vrai) |
fprintf(flux, " In exception = catch\n"); |
? "1" : "0"); |
} |
|
|
fprintf(flux, " F=%c%c L=%lu ", |
|
((*l_element_courant).clause == ' ') ? '-' : |
|
(*l_element_courant).clause, |
|
((*l_element_courant).type_cloture == ' ') ? '-' : |
|
(*l_element_courant).type_cloture, |
|
(*l_element_courant).niveau_courant); |
|
|
|
if ((*l_element_courant).retour_definition == 'Y') |
if ((*l_element_courant).clause != ' ') |
{ |
{ |
fprintf(flux, "RTN "); |
fprintf(flux, " Structure = "); |
|
|
if ((*l_element_courant).origine_routine_evaluation == 'Y') |
switch((*l_element_courant).clause) |
{ |
{ |
fprintf(flux, "EVL "); |
case 'I': |
|
fprintf(flux, "IF\n"); |
|
break; |
|
|
|
case 'R': |
|
fprintf(flux, "IFERR\n"); |
|
break; |
|
|
|
case 'X': |
|
fprintf(flux, "exception caught by IFERR\n"); |
|
break; |
|
|
|
case 'T': |
|
fprintf(flux, "THEN\n"); |
|
break; |
|
|
|
case 'E': |
|
fprintf(flux, "ELSE\n"); |
|
break; |
|
|
|
case 'Z': |
|
fprintf(flux, "ELSE (false condition)\n"); |
|
break; |
|
|
|
case 'D': |
|
fprintf(flux, "DO\n"); |
|
break; |
|
|
|
case 'U': |
|
fprintf(flux, "UNTIL\n"); |
|
break; |
|
|
|
case 'W': |
|
fprintf(flux, "WHILE\n"); |
|
break; |
|
|
|
case 'M': |
|
fprintf(flux, "WHILE (false condition)\n"); |
|
break; |
|
|
|
case 'S': |
|
fprintf(flux, "SELECT\n"); |
|
break; |
|
|
|
case 'K': |
|
fprintf(flux, "CASE (no true condition)\n"); |
|
break; |
|
|
|
case 'C': |
|
fprintf(flux, "CASE (one or more true conditions)\n"); |
|
break; |
|
|
|
case 'Q': |
|
fprintf(flux, "CASE (treatment of a true condition)\n"); |
|
break; |
|
|
|
case 'F': |
|
fprintf(flux, "CASE (treatment of default case)\n"); |
|
break; |
} |
} |
else |
} |
|
|
|
if ((*l_element_courant).type_cloture != ' ') |
|
{ |
|
fprintf(flux, " Next close = "); |
|
|
|
switch((*l_element_courant).type_cloture) |
{ |
{ |
fprintf(flux, "SEQ "); |
case 'C': |
|
fprintf(flux, "SELECT\n"); |
|
break; |
|
|
if ((*l_element_courant).adresse_retour != 0) |
case 'D': |
|
fprintf(flux, "DO\n"); |
|
break; |
|
|
|
case 'I': |
|
fprintf(flux, "IF\n"); |
|
break; |
|
|
|
case 'J': |
|
fprintf(flux, "IFERR\n"); |
|
break; |
|
|
|
case 'K': |
|
fprintf(flux, "CASE\n"); |
|
break; |
|
|
|
case 'W': |
|
fprintf(flux, "WHILE\n"); |
|
break; |
|
|
|
case 'Q': |
|
fprintf(flux, "CRITICAL\n"); |
|
break; |
|
|
|
case 'F': |
|
fprintf(flux, "FOR\n"); |
|
break; |
|
|
|
case 'S': |
|
fprintf(flux, "START\n"); |
|
break; |
|
|
|
case 'L': |
|
fprintf(flux, "internal loop\n"); |
|
break; |
|
|
|
case 'A': |
|
fprintf(flux, "FORALL\n"); |
|
break; |
|
} |
|
} |
|
|
|
fprintf(flux, " Level = %lld\n", |
|
(long long int) (*l_element_courant).niveau_courant); |
|
|
|
if ((*l_element_courant).retour_definition == 'Y') |
|
{ |
|
fprintf(flux, " Return = yes\n"); |
|
|
|
if ((*l_element_courant).origine_routine_evaluation == 'Y') |
|
{ |
|
if ((*l_element_courant).pointeur_objet_retour != NULL) |
{ |
{ |
fprintf(flux, "P=%016X", (*l_element_courant) |
fprintf(flux, " Come from = compiled code "); |
.adresse_retour); |
fprintf(flux, "(address # %016Xh)\n", (*l_element_courant) |
|
.pointeur_objet_retour); |
|
|
// Calcul de la routine de départ |
// Calcul de la routine de départ |
|
|
l_variable = (struct_liste_chainee *) |
candidat = -1; |
(*(*(*s_etat_processus) |
|
.l_liste_variables_par_niveau).precedent).liste; |
|
candidat = (*s_etat_processus) |
|
.longueur_definitions_chainees; |
|
l_candidat = NULL; |
|
|
|
// l_variable balaie les variables de niveau 0. |
|
|
|
while(l_variable != NULL) |
for(j = 0; j < nb_variables; j++) |
{ |
{ |
if ((*(*((struct_variable *) (*l_variable).donnee)) |
if (tableau[j].objet != NULL) |
.objet).type == ADR) |
|
{ |
{ |
delta = (*l_element_courant).adresse_retour |
// Variable ni partagée ni statique |
- (*((unsigned long *) |
if (((*(tableau[j].objet)).type == RPN) || |
(*(*((struct_variable *) (*l_variable) |
((*(tableau[j].objet)).type == ALG)) |
.donnee)).objet).objet)); |
|
|
|
if ((delta > 0) && (delta < candidat)) |
|
{ |
{ |
candidat = delta; |
l_element_expression = |
l_candidat = l_variable; |
(*(tableau[j].objet)).objet; |
|
|
|
while(l_element_expression != NULL) |
|
{ |
|
if (l_element_expression == |
|
(*l_element_courant) |
|
.pointeur_objet_retour) |
|
{ |
|
candidat = j; |
|
break; |
|
} |
|
|
|
l_element_expression = |
|
(*l_element_expression).suivant; |
|
} |
|
|
|
if (candidat != -1) |
|
{ |
|
break; |
|
} |
} |
} |
} |
} |
|
|
l_variable = (*l_variable).suivant; |
|
} |
} |
|
|
if (l_candidat != NULL) |
if (candidat != -1) |
{ |
{ |
fprintf(flux, "\n Call from %s", |
fprintf(flux, " = %s [", |
(*((struct_variable *) (*l_candidat).donnee)) |
tableau[candidat].nom); |
.nom); |
|
|
if ((*(tableau[candidat].objet)).type == RPN) |
|
{ |
|
fprintf(flux, "definition"); |
|
} |
|
else if ((*(tableau[candidat].objet)).type == ALG) |
|
{ |
|
fprintf(flux, "algebraic"); |
|
} |
|
else if ((*(tableau[candidat].objet)).type == NOM) |
|
{ |
|
fprintf(flux, "name"); |
|
} |
|
else |
|
{ |
|
fprintf(flux, "unknown"); |
|
} |
|
|
|
fprintf(flux, "]\n"); |
} |
} |
else |
else |
{ |
{ |
fprintf(flux, "\n Call from RPL/2 initialization"); |
fprintf(flux, " = " |
|
"optimized definition\n"); |
} |
} |
} |
} |
else |
else |
{ |
{ |
fprintf(flux, "RPL/2 initialization"); |
fprintf(flux, " Come from = compiled code\n"); |
|
fprintf(flux, " = " |
|
"optimized definition\n"); |
} |
} |
} |
} |
} |
|
else |
|
{ |
|
fprintf(flux, "NONE "); |
|
|
|
if ((*l_element_courant).origine_routine_evaluation == 'Y') |
|
{ |
|
fprintf(flux, "EVL "); |
|
} |
|
else |
else |
{ |
{ |
fprintf(flux, "SEQ "); |
fprintf(flux, " Come from = interpreted code "); |
|
|
if ((*l_element_courant).pointeur_adresse_retour != NULL) |
if ((*l_element_courant).adresse_retour != 0) |
{ |
{ |
fprintf(flux, "A=%016X ", (*l_element_courant) |
fprintf(flux, "(offset # %016Xh)\n", (*l_element_courant) |
.pointeur_adresse_retour); |
.adresse_retour); |
|
|
// Calcul de la routine de départ |
// Calcul de la routine de départ |
|
|
l_variable = (struct_liste_chainee *) |
candidat8 = (*s_etat_processus) |
(*(*(*s_etat_processus) |
|
.l_liste_variables_par_niveau).precedent).liste; |
|
candidat = (*s_etat_processus) |
|
.longueur_definitions_chainees; |
.longueur_definitions_chainees; |
l_candidat = NULL; |
candidat = -1; |
|
|
// l_variable balaie les variables de niveau 0. |
|
|
|
while(l_variable != NULL) |
for(j = 0; j < nb_variables; j++) |
{ |
{ |
if ( (*(*l_variable).donnee).objet == |
if ((*(tableau[j].objet)).type == ADR) |
(*l_element_courant).pointeur_adresse_retour) |
|
{ |
{ |
l_candidat = l_variable; |
delta = (*l_element_courant).adresse_retour |
break; |
- (*((integer8 *) |
} |
(*(tableau[j].objet)).objet)); |
|
|
l_variable = (*l_variable).suivant; |
if ((delta >= 0) && (delta < candidat8)) |
|
{ |
|
candidat8 = delta; |
|
candidat = j; |
|
} |
|
} |
} |
} |
|
|
if (l_candidat != NULL) |
if (candidat != -1) |
{ |
{ |
fprintf(flux, "\n Branch to %s", |
fprintf(flux, " = %s\n", |
(*((struct_variable *) (*l_candidat).donnee)) |
tableau[candidat].nom); |
.nom); |
|
} |
} |
else |
else |
{ |
{ |
fprintf(flux, "\n Branch to evaluation subroutine"); |
fprintf(flux, " = " |
|
"unknown definition\n"); |
} |
} |
} |
} |
|
else if ((*l_element_courant).niveau_courant == 0) |
|
{ |
|
fprintf(flux, "\n"); |
|
fprintf(flux, " = RPL/2 " |
|
"initialization\n"); |
|
} |
|
else |
|
{ |
|
fprintf(flux, "\n"); |
|
} |
} |
} |
} |
} |
|
else |
|
{ |
|
fprintf(flux, " Return = no\n"); |
|
} |
|
|
fprintf(flux, "\n"); |
if (((*l_element_courant).indice_boucle != NULL) && |
|
((*l_element_courant).type_cloture != 'A')) |
if ((*l_element_courant).indice_boucle != NULL) |
|
{ |
{ |
tampon = formateur(s_etat_processus, 0, |
tampon = formateur(s_etat_processus, 24, |
(*l_element_courant).indice_boucle); |
(*l_element_courant).indice_boucle); |
fprintf(flux, " Index = %s\n", tampon); |
fprintf(flux, " Index = %s\n", tampon); |
free(tampon); |
free(tampon); |
} |
} |
|
|
if ((*l_element_courant).limite_indice_boucle != NULL) |
if ((*l_element_courant).limite_indice_boucle != NULL) |
{ |
{ |
tampon = formateur(s_etat_processus, 0, |
tampon = formateur(s_etat_processus, 24, |
(*l_element_courant).limite_indice_boucle); |
(*l_element_courant).limite_indice_boucle); |
fprintf(flux, " Limit = %s\n", tampon); |
fprintf(flux, " Limit = %s\n", tampon); |
free(tampon); |
free(tampon); |
} |
} |
|
|
if ((*l_element_courant).objet_de_test != NULL) |
if ((*l_element_courant).objet_de_test != NULL) |
{ |
{ |
tampon = formateur(s_etat_processus, 0, |
tampon = formateur(s_etat_processus, 24, |
(*l_element_courant).objet_de_test); |
(*l_element_courant).objet_de_test); |
fprintf(flux, " Test object = %s\n", tampon); |
fprintf(flux, " Test object = %s\n", tampon); |
free(tampon); |
free(tampon); |
} |
} |
|
|
if ((*l_element_courant).nom_variable != NULL) |
if ((*l_element_courant).nom_variable != NULL) |
{ |
{ |
fprintf(flux, " Variable name = %s\n", |
fprintf(flux, " Variable name = %s\n", |
(*l_element_courant).nom_variable); |
(*l_element_courant).nom_variable); |
} |
} |
|
|
|
fprintf(flux, "\n"); |
|
|
l_element_courant = (*l_element_courant).suivant; |
l_element_courant = (*l_element_courant).suivant; |
} |
} |
|
|
fprintf(flux, "\n"); |
|
funlockfile(flux); |
funlockfile(flux); |
|
|
|
free(tableau); |
|
|
return; |
return; |
} |
} |
|
|