version 1.2, 2010/01/27 22:22:10
|
version 1.56, 2013/03/16 11:31:41
|
Line 1
|
Line 1
|
/* |
/* |
================================================================================ |
================================================================================ |
RPL/2 (R) version 4.0.10 |
RPL/2 (R) version 4.1.13 |
Copyright (C) 1989-2010 Dr. BERTRAND Joël |
Copyright (C) 1989-2013 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 47 formateur(struct_processus *s_etat_proce
|
Line 47 formateur(struct_processus *s_etat_proce
|
logical4 autorisation_parenthese; |
logical4 autorisation_parenthese; |
logical4 presence_signe; |
logical4 presence_signe; |
|
|
|
long longueur_chaine; |
|
|
struct_liste_chainee *l_atome; |
struct_liste_chainee *l_atome; |
struct_liste_chainee *l_element_courant; |
struct_liste_chainee *l_element_courant; |
struct_liste_chainee *l_liste1; |
struct_liste_chainee *l_liste1; |
Line 73 formateur(struct_processus *s_etat_proce
|
Line 75 formateur(struct_processus *s_etat_proce
|
unsigned long i; |
unsigned long i; |
unsigned long j; |
unsigned long j; |
unsigned long k; |
unsigned long k; |
unsigned long longueur_binaire; |
|
unsigned long longueur_courante; |
unsigned long longueur_courante; |
unsigned long longueur_decimale_courante; |
unsigned long longueur_decimale_courante; |
unsigned long *longueurs_maximales; |
unsigned long *longueurs_maximales; |
Line 92 formateur(struct_processus *s_etat_proce
|
Line 93 formateur(struct_processus *s_etat_proce
|
|
|
strcpy(base, " "); |
strcpy(base, " "); |
|
|
longueur_binaire = 0; |
|
masque_binaire = 0; |
masque_binaire = 0; |
|
|
if ((*s_objet).type == ADR) |
if ((*s_objet).type == ADR) |
Line 104 formateur(struct_processus *s_etat_proce
|
Line 104 formateur(struct_processus *s_etat_proce
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
sprintf(tampon, "%016lX", (*((unsigned long *) ((*s_objet).objet)))); |
if (alsprintf(&chaine, "@ %016lX", (*((unsigned long *) |
|
((*s_objet).objet)))) < 0) |
chaine = (unsigned char *) malloc((strlen(tampon) + 3) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
strcpy(chaine, "@ "); |
|
strcat(chaine, tampon); |
|
} |
} |
else if ((*s_objet).type == SLB) |
else if ((*s_objet).type == SLB) |
{ |
{ |
Line 127 formateur(struct_processus *s_etat_proce
|
Line 120 formateur(struct_processus *s_etat_proce
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
sprintf(tampon, " %016lX", (unsigned long) (*((struct_bibliotheque *) |
if (alsprintf(&chaine, "Library $ %016lX [%s]", |
(*s_objet).objet)).descripteur); |
(unsigned long) (*((struct_bibliotheque *) |
|
(*s_objet).objet)).descripteur, (*((struct_bibliotheque *) |
chaine = (unsigned char *) malloc((strlen(tampon) + 10) |
(*s_objet).objet)).nom) < 0) |
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
strcpy(chaine, "Library $"); |
|
strcat(chaine, tampon); |
|
|
|
registre = chaine; |
|
|
|
if ((chaine = malloc((strlen(registre) + 2 + |
|
strlen((*(struct_bibliotheque *) ((*s_objet).objet)).nom) |
|
+ 2) * sizeof(unsigned char))) == NULL) |
|
{ |
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
return(NULL); |
|
} |
|
|
|
sprintf(chaine, "%s [%s]", registre, (*((struct_bibliotheque *) |
|
(*s_objet).objet)).nom); |
|
free(registre); |
|
} |
} |
else if ((*s_objet).type == SPH) |
else if ((*s_objet).type == SPH) |
{ |
{ |
Line 165 formateur(struct_processus *s_etat_proce
|
Line 138 formateur(struct_processus *s_etat_proce
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
sprintf(tampon, "%016lX", (unsigned long) |
if (alsprintf(&chaine, "Semaphore $ %016lX '%s'", |
&((*((struct_semaphore *) (*s_objet).objet)).semaphore)); |
&((*((struct_semaphore *) (*s_objet).objet)).semaphore), |
|
(*((struct_semaphore *) (*s_objet).objet)).nom) < 0) |
chaine = (unsigned char *) malloc((strlen(tampon) + 15 + |
|
strlen((*((struct_semaphore *) (*s_objet).objet)).nom)) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
sprintf(chaine, "Semaphore $%s '%s'", tampon, |
|
(*((struct_semaphore *) (*s_objet).objet)).nom); |
|
} |
} |
else if ((*s_objet).type == SQL) |
else if ((*s_objet).type == SQL) |
{ |
{ |
Line 194 formateur(struct_processus *s_etat_proce
|
Line 159 formateur(struct_processus *s_etat_proce
|
"MYSQL") == 0) |
"MYSQL") == 0) |
{ |
{ |
# ifdef MYSQL_SUPPORT |
# ifdef MYSQL_SUPPORT |
sprintf(tampon, "Sql $%016lX (%s)", |
if (alsprintf(&chaine, "Sql $ %016lX (%s)", |
(long unsigned int) (*((struct_connecteur_sql *) |
(long unsigned int) (*((struct_connecteur_sql *) |
(*s_objet).objet)).descripteur.mysql, |
(*s_objet).objet)).descripteur.mysql, |
(*((struct_connecteur_sql *) (*s_objet).objet)).type); |
(*((struct_connecteur_sql *) (*s_objet).objet)).type) < 0) |
|
{ |
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
return(NULL); |
|
} |
# else |
# else |
if ((*s_etat_processus).langue == 'F') |
if ((*s_etat_processus).langue == 'F') |
{ |
{ |
Line 217 formateur(struct_processus *s_etat_proce
|
Line 186 formateur(struct_processus *s_etat_proce
|
"POSTGRESQL") == 0) |
"POSTGRESQL") == 0) |
{ |
{ |
# ifdef POSTGRESQL_SUPPORT |
# ifdef POSTGRESQL_SUPPORT |
sprintf(tampon, "Sql $%016lX [ %s ]", |
if (alsprintf(&chaine, "Sql $ %016lX (%s)", |
(long unsigned int) (*((struct_connecteur_sql *) |
(long unsigned int) (*((struct_connecteur_sql *) |
(*s_objet).objet)).descripteur.postgresql, |
(*s_objet).objet)).descripteur.postgresql, |
(*((struct_connecteur_sql *) (*s_objet).objet)).type); |
(*((struct_connecteur_sql *) (*s_objet).objet)).type) < 0) |
|
{ |
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
return(NULL); |
|
} |
# else |
# else |
if ((*s_etat_processus).langue == 'F') |
if ((*s_etat_processus).langue == 'F') |
{ |
{ |
Line 242 formateur(struct_processus *s_etat_proce
|
Line 215 formateur(struct_processus *s_etat_proce
|
(*((struct_connecteur_sql *) (*s_objet).objet)) |
(*((struct_connecteur_sql *) (*s_objet).objet)) |
.type)); |
.type)); |
} |
} |
|
|
chaine = (unsigned char *) malloc((strlen(tampon) + 1) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
return(NULL); |
|
} |
|
|
|
strcpy(chaine, tampon); |
|
} |
} |
else if ((*s_objet).type == PRC) |
else if ((*s_objet).type == PRC) |
{ |
{ |
Line 266 formateur(struct_processus *s_etat_proce
|
Line 228 formateur(struct_processus *s_etat_proce
|
if ((*(*((struct_processus_fils *) (*s_objet).objet)).thread) |
if ((*(*((struct_processus_fils *) (*s_objet).objet)).thread) |
.processus_detache == d_vrai) |
.processus_detache == d_vrai) |
{ |
{ |
sprintf(tampon, " %016lX", (unsigned long) |
if (alsprintf(&chaine, "Process $ %016lX", (unsigned long) |
(*(*((struct_processus_fils *) (*s_objet).objet)).thread) |
(*(*((struct_processus_fils *) (*s_objet).objet)).thread) |
.pid); |
.pid) < 0) |
|
|
chaine = (unsigned char *) malloc((strlen(tampon) + 10) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
strcpy(chaine, "Process $"); |
|
strcat(chaine, tampon); |
|
} |
} |
else |
else |
{ |
{ |
sprintf(tampon, " %016lX/%016lX", |
if (alsprintf(&chaine, "Light weight process $ %016lX/%016lX", |
(unsigned long) (*(*((struct_processus_fils *) |
(unsigned long) (*(*((struct_processus_fils *) |
(*s_objet).objet)).thread).pid, |
(*s_objet).objet)).thread).pid, |
(unsigned long) (*(*((struct_processus_fils *) |
(unsigned long) (*(*((struct_processus_fils *) |
(*s_objet).objet)).thread).tid); |
(*s_objet).objet)).thread).tid) < 0) |
|
|
chaine = (unsigned char *) malloc((strlen(tampon) + 23) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
strcpy(chaine, "Light weight process $"); |
|
strcat(chaine, tampon); |
|
} |
} |
} |
} |
else if ((*s_objet).type == FCH) |
else if ((*s_objet).type == FCH) |
Line 312 formateur(struct_processus *s_etat_proce
|
Line 258 formateur(struct_processus *s_etat_proce
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
sprintf(tampon, " %016lX", (unsigned long) (*((struct_fichier *) |
if (alsprintf(&chaine, "File $ %016lX", (unsigned long) |
((*s_objet).objet))).descripteur); |
(*((struct_fichier *) ((*s_objet).objet))).descripteur) < 0) |
|
|
chaine = (unsigned char *) malloc((strlen(tampon) + 7) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
strcpy(chaine, "File $"); |
|
strcat(chaine, tampon); |
|
|
|
registre45 = test_cfsf(s_etat_processus, 45); |
registre45 = test_cfsf(s_etat_processus, 45); |
cf(s_etat_processus, 45); |
cf(s_etat_processus, 45); |
|
|
Line 452 formateur(struct_processus *s_etat_proce
|
Line 390 formateur(struct_processus *s_etat_proce
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
sprintf(tampon, " %016lX", (unsigned long) (*((struct_socket *) |
if (alsprintf(&chaine, "Socket $ %016lX", |
((*s_objet).objet))).socket); |
(unsigned long) (*((struct_socket *) |
|
((*s_objet).objet))).socket) < 0) |
chaine = (unsigned char *) malloc((strlen(tampon) + 9) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
strcpy(chaine, "Socket $"); |
|
strcat(chaine, tampon); |
|
|
|
registre45 = test_cfsf(s_etat_processus, 45); |
registre45 = test_cfsf(s_etat_processus, 45); |
cf(s_etat_processus, 45); |
cf(s_etat_processus, 45); |
|
|
Line 1647 formateur(struct_processus *s_etat_proce
|
Line 1578 formateur(struct_processus *s_etat_proce
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
longueur_binaire = longueur_entiers_binaires(s_etat_processus); |
|
masque_binaire = masque_entiers_binaires(s_etat_processus); |
masque_binaire = masque_entiers_binaires(s_etat_processus); |
|
|
if ((test_cfsf(s_etat_processus, 43) == d_faux) && |
if ((test_cfsf(s_etat_processus, 43) == d_faux) && |
Line 1819 formateur(struct_processus *s_etat_proce
|
Line 1749 formateur(struct_processus *s_etat_proce
|
-------------------------------------------------------------------------------- |
-------------------------------------------------------------------------------- |
*/ |
*/ |
|
|
chaine = (unsigned char *) malloc((strlen((unsigned char *) |
if (((*s_etat_processus).autorisation_conversion_chaine == 'Y') && |
((*s_objet).objet)) + 1) * sizeof(unsigned char)); |
(test_cfsf(s_etat_processus, 34) == d_vrai)) |
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
if ((chaine = formateur_flux(s_etat_processus, |
return(NULL); |
(unsigned char *) (*s_objet).objet, &longueur_chaine)) |
|
== NULL) |
|
{ |
|
return(NULL); |
|
} |
} |
} |
|
else |
|
{ |
|
if ((chaine = malloc((strlen((unsigned char *) |
|
((*s_objet).objet)) + 1) * sizeof(unsigned char))) == NULL) |
|
{ |
|
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
|
return(NULL); |
|
} |
|
|
strcpy(chaine, (unsigned char *) ((*s_objet).objet)); |
strcpy(chaine, (unsigned char *) ((*s_objet).objet)); |
|
} |
} |
} |
else if ((*s_objet).type == CPL) |
else if ((*s_objet).type == CPL) |
{ |
{ |
Line 3052 formateur(struct_processus *s_etat_proce
|
Line 2993 formateur(struct_processus *s_etat_proce
|
} |
} |
else if ((*s_objet).type == MTX) |
else if ((*s_objet).type == MTX) |
{ |
{ |
sprintf(tampon, " %016lX", (unsigned long) |
if (alsprintf(&chaine, "Mutex $ %016lX owned by $ %016lX", |
&((*((struct_mutex *) (*s_objet).objet)).mutex)); |
(unsigned long) &((*((struct_mutex *) (*s_objet).objet)).mutex), |
|
(unsigned long) (*((struct_mutex *) (*s_objet).objet)).tid) < 0) |
chaine = (unsigned char *) malloc((strlen(tampon) + 8) |
|
* sizeof(unsigned char)); |
|
|
|
if (chaine == NULL) |
|
{ |
{ |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire; |
return(NULL); |
return(NULL); |
} |
} |
|
|
strcpy(chaine, "Mutex $"); |
|
strcat(chaine, tampon); |
|
} |
} |
else if ((*s_objet).type == NOM) |
else if ((*s_objet).type == NOM) |
{ |
{ |
Line 3512 formateur_reel(struct_processus *s_etat_
|
Line 3446 formateur_reel(struct_processus *s_etat_
|
logical1 i50; |
logical1 i50; |
|
|
long correction; |
long correction; |
|
long dernier_chiffre_significatif; |
long exposant; |
long exposant; |
long longueur_utile; |
long longueur_utile; |
long longueur_utile_limite; |
long longueur_utile_limite; |
|
|
unsigned char *chaine; |
unsigned char *chaine; |
unsigned char format[16 + 1]; |
unsigned char format[32 + 1]; |
unsigned char mode[3 + 1]; |
unsigned char mode[3 + 1]; |
unsigned char *ptr; |
unsigned char *ptr; |
unsigned char tampon[16 + 1]; |
unsigned char tampon[32 + 1]; |
|
|
unsigned long i; |
unsigned long i; |
unsigned long j; |
unsigned long j; |
Line 3536 formateur_reel(struct_processus *s_etat_
|
Line 3471 formateur_reel(struct_processus *s_etat_
|
|
|
if (type == 'R') |
if (type == 'R') |
{ |
{ |
|
# ifdef FP_INFINITE |
|
int signe; |
|
|
|
if ((signe = isinf((*((real8 *) valeur_numerique)))) != 0) |
|
{ |
|
if (signe > 0) |
|
{ |
|
strcpy(chaine, "infinity"); |
|
} |
|
else |
|
{ |
|
strcpy(chaine, "-infinity"); |
|
} |
|
|
|
return(chaine); |
|
} |
|
# endif |
|
|
|
if (isnan((*((real8 *) valeur_numerique)))) |
|
{ |
|
strcpy(chaine, "undef"); |
|
return(chaine); |
|
} |
|
|
tampon_reel = *((real8 *) valeur_numerique); |
tampon_reel = *((real8 *) valeur_numerique); |
|
|
if (tampon_reel > ((real8) 0)) |
if (tampon_reel > ((real8) 0)) |
Line 3563 formateur_reel(struct_processus *s_etat_
|
Line 3522 formateur_reel(struct_processus *s_etat_
|
} |
} |
else if (tampon_entier < ((integer8) 0)) |
else if (tampon_entier < ((integer8) 0)) |
{ |
{ |
exposant = (long) floor(log10(-tampon_entier)); |
if (tampon_entier != INT64_MIN) |
|
{ |
|
exposant = (long) floor(log10(-tampon_entier)); |
|
} |
|
else |
|
{ |
|
tampon_reel = (real8) tampon_entier; |
|
exposant = (long) floor(log10(-tampon_reel)); |
|
} |
} |
} |
else |
else |
{ |
{ |
Line 3644 formateur_reel(struct_processus *s_etat_
|
Line 3611 formateur_reel(struct_processus *s_etat_
|
} |
} |
} |
} |
|
|
|
// Test portant sur le nombre de chiffres significatifs dans |
|
// le cas du format STD pour que 1.2E-15 apparaisse en notation |
|
// SCI car il y a une perte de précision dans l'affichage. |
|
|
|
if ((strcmp(mode, "STD") == 0) && (type == 'R')) |
|
{ |
|
if (abs(*((real8 *) valeur_numerique)) < 1) |
|
{ |
|
dernier_chiffre_significatif = -exposant; |
|
sprintf(tampon, ".%f", mantisse); |
|
|
|
ptr = &(tampon[strlen(tampon) - 1]); |
|
|
|
while((*ptr) != '.') |
|
{ |
|
if ((*ptr) != '0') |
|
{ |
|
dernier_chiffre_significatif++; |
|
} |
|
|
|
ptr--; |
|
} |
|
} |
|
else |
|
{ |
|
dernier_chiffre_significatif = 0; |
|
} |
|
} |
|
else |
|
{ |
|
dernier_chiffre_significatif = 0; |
|
} |
|
|
if ((strcmp(mode, "SCI") == 0) || |
if ((strcmp(mode, "SCI") == 0) || |
((strcmp(mode, "STD") == 0) && ((exposant > |
((strcmp(mode, "STD") == 0) && ((exposant > |
longueur_utile_limite) || |
longueur_utile_limite) || (dernier_chiffre_significatif > 15) || |
(exposant < -longueur_utile_limite))) || |
(exposant < -longueur_utile_limite))) || |
((strcmp(mode, "FIX") == 0) && |
((strcmp(mode, "FIX") == 0) && |
((exposant >= longueur_utile_limite) || |
((exposant >= longueur_utile_limite) || |
Line 3733 formateur_reel(struct_processus *s_etat_
|
Line 3733 formateur_reel(struct_processus *s_etat_
|
|
|
if (exposant >= 0) |
if (exposant >= 0) |
{ |
{ |
sprintf(format, "%%.%luf", (longueur_utile_limite - exposant |
if ((exposant + 1) < longueur_utile_limite) |
- 1)); |
{ |
|
sprintf(format, "%%.%luf", (longueur_utile_limite - exposant |
|
- 1)); |
|
} |
|
else |
|
{ |
|
strcpy(format, "%.0f."); |
|
} |
} |
} |
else |
else |
{ |
{ |
Line 3759 formateur_reel(struct_processus *s_etat_
|
Line 3766 formateur_reel(struct_processus *s_etat_
|
} |
} |
} |
} |
} |
} |
|
|
strcpy(chaine, tampon); |
strcpy(chaine, tampon); |
} |
} |
|
|