version 1.61, 2013/03/20 17:11:43
|
version 1.78, 2014/07/17 08:07:17
|
Line 1
|
Line 1
|
/* |
/* |
================================================================================ |
================================================================================ |
RPL/2 (R) version 4.1.13 |
RPL/2 (R) version 4.1.19 |
Copyright (C) 1989-2013 Dr. BERTRAND Joël |
Copyright (C) 1989-2014 Dr. BERTRAND Joël |
|
|
This file is part of RPL/2. |
This file is part of RPL/2. |
|
|
Line 19
|
Line 19
|
================================================================================ |
================================================================================ |
*/ |
*/ |
|
|
#define DEBUG_ERREURS |
|
#include "rpl-conv.h" |
#include "rpl-conv.h" |
|
|
|
|
Line 85 formateur_fichier(struct_processus *s_et
|
Line 85 formateur_fichier(struct_processus *s_et
|
struct_liste_chainee *l_liste1; |
struct_liste_chainee *l_liste1; |
struct_liste_chainee *l_liste2; |
struct_liste_chainee *l_liste2; |
|
|
|
struct_objet *s_format_tmp; |
struct_objet *s_sous_objet; |
struct_objet *s_sous_objet; |
struct_objet *s_sous_objet_1; |
struct_objet *s_sous_objet_1; |
struct_objet *s_sous_objet_2; |
struct_objet *s_sous_objet_2; |
Line 1000 formateur_fichier(struct_processus *s_et
|
Line 1001 formateur_fichier(struct_processus *s_et
|
|
|
if (format_sortie == 'N') |
if (format_sortie == 'N') |
{ |
{ |
sprintf(tampon, "%llX", (*((logical8 *) |
sprintf(tampon, "%llX", (unsigned long long) (*((logical8 *) |
((*s_objet).objet)))); |
((*s_objet).objet)))); |
strcpy(base, "h"); |
strcpy(base, "h"); |
} |
} |
Line 1010 formateur_fichier(struct_processus *s_et
|
Line 1011 formateur_fichier(struct_processus *s_et
|
{ |
{ |
case 2: |
case 2: |
{ |
{ |
sprintf(tampon, "%llX", (*((logical8 *) |
sprintf(tampon, "%llX", (unsigned long long) |
((*s_objet).objet)))); |
(*((logical8 *) ((*s_objet).objet)))); |
|
|
chaine = (unsigned char *) malloc((strlen(tampon) + 1) |
chaine = (unsigned char *) malloc((strlen(tampon) + 1) |
* sizeof(unsigned char)); |
* sizeof(unsigned char)); |
Line 1120 formateur_fichier(struct_processus *s_et
|
Line 1121 formateur_fichier(struct_processus *s_et
|
|
|
case 8: |
case 8: |
{ |
{ |
sprintf(tampon, "%llo", (*((logical8 *) |
sprintf(tampon, "%llo", (*((unsigned long long *) |
((*s_objet).objet)))); |
((*s_objet).objet)))); |
strcpy(base, "o"); |
strcpy(base, "o"); |
break; |
break; |
Line 1128 formateur_fichier(struct_processus *s_et
|
Line 1129 formateur_fichier(struct_processus *s_et
|
|
|
case 10: |
case 10: |
{ |
{ |
sprintf(tampon, "%llu", (*((logical8 *) |
sprintf(tampon, "%llu", (*((unsigned long long *) |
((*s_objet).objet)))); |
((*s_objet).objet)))); |
strcpy(base, "d"); |
strcpy(base, "d"); |
break; |
break; |
Line 1136 formateur_fichier(struct_processus *s_et
|
Line 1137 formateur_fichier(struct_processus *s_et
|
|
|
case 16: |
case 16: |
{ |
{ |
sprintf(tampon, "%llX", (*((logical8 *) |
sprintf(tampon, "%llX", (unsigned long long) |
((*s_objet).objet)))); |
(*((logical8 *) ((*s_objet).objet)))); |
strcpy(base, "h"); |
strcpy(base, "h"); |
break; |
break; |
} |
} |
Line 1673 formateur_fichier(struct_processus *s_et
|
Line 1674 formateur_fichier(struct_processus *s_et
|
|
|
chaine_sauvegarde = chaine; |
chaine_sauvegarde = chaine; |
|
|
|
// Si le format_sortie vaut 'N', on remplace le format par |
|
// { "native*(*)" }. L'intérêt est de pouvoir traiter une |
|
// liste par un format "native*(*)". |
|
|
|
if ((format_sortie == 'N') && ((*(*l_element_courant) |
|
.donnee).type == LST)) |
|
{ |
|
if ((s_format_tmp = allocation(s_etat_processus, LST)) |
|
== NULL) |
|
{ |
|
return(NULL); |
|
} |
|
|
|
if (((*s_format_tmp).objet = allocation_maillon( |
|
s_etat_processus)) == NULL) |
|
{ |
|
return(NULL); |
|
} |
|
|
|
(*((struct_liste_chainee *) (*s_format_tmp).objet)) |
|
.suivant = NULL; |
|
|
|
if (((*((struct_liste_chainee *) (*s_format_tmp).objet)) |
|
.donnee = allocation(s_etat_processus, CHN)) |
|
== NULL) |
|
{ |
|
return(NULL); |
|
} |
|
|
|
if (((*(*((struct_liste_chainee *) (*s_format_tmp) |
|
.objet)).donnee).objet = malloc(11 * |
|
sizeof(unsigned char))) == NULL) |
|
{ |
|
(*s_etat_processus).erreur_systeme = |
|
d_es_allocation_memoire; |
|
return(NULL); |
|
} |
|
|
|
strcpy((unsigned char *) (*(*((struct_liste_chainee *) |
|
(*s_format_tmp).objet)).donnee).objet, |
|
"native*(*)"); |
|
} |
|
else |
|
{ |
|
if ((s_format_tmp = copie_objet(s_etat_processus, |
|
s_format, 'P')) == NULL) |
|
{ |
|
return(NULL); |
|
} |
|
} |
|
|
if ((chaine_formatee = formateur_fichier(s_etat_processus, |
if ((chaine_formatee = formateur_fichier(s_etat_processus, |
(*l_element_courant).donnee, s_format, |
(*l_element_courant).donnee, s_format, |
longueur, longueur_champ, format_sortie, type, |
longueur, longueur_champ, format_sortie, type, |
longueur_effective, recursivite, export_fichier)) |
longueur_effective, recursivite, export_fichier)) |
== NULL) |
== NULL) |
{ |
{ |
|
liberation(s_etat_processus, s_format_tmp); |
free(chaine); |
free(chaine); |
return(NULL); |
return(NULL); |
} |
} |
|
|
|
liberation(s_etat_processus, s_format_tmp); |
|
|
if ((*(*l_element_courant).donnee).type == CHN) |
if ((*(*l_element_courant).donnee).type == CHN) |
{ |
{ |
chaine = (unsigned char *) |
chaine = (unsigned char *) |
Line 3785 formateur_fichier(struct_processus *s_et
|
Line 3840 formateur_fichier(struct_processus *s_et
|
} |
} |
|
|
free(format_chaine); |
free(format_chaine); |
|
|
|
// Si le format_sortie vaut 'N', on remplace le format par |
|
// { "native*(*)" }. L'intérêt est de pouvoir traiter une |
|
// liste par un format "native*(*)". |
|
|
|
if ((format_sortie == 'N') && ((*(*l_element_courant) |
|
.donnee).type == LST)) |
|
{ |
|
if ((s_format_tmp = allocation(s_etat_processus, LST)) |
|
== NULL) |
|
{ |
|
return(NULL); |
|
} |
|
|
|
if (((*s_format_tmp).objet = allocation_maillon( |
|
s_etat_processus)) == NULL) |
|
{ |
|
return(NULL); |
|
} |
|
|
|
(*((struct_liste_chainee *) (*s_format_tmp).objet)) |
|
.suivant = NULL; |
|
|
|
if (((*((struct_liste_chainee *) (*s_format_tmp).objet)) |
|
.donnee = allocation(s_etat_processus, CHN)) |
|
== NULL) |
|
{ |
|
return(NULL); |
|
} |
|
|
|
if (((*(*((struct_liste_chainee *) (*s_format_tmp) |
|
.objet)).donnee).objet = malloc(11 * |
|
sizeof(unsigned char))) == NULL) |
|
{ |
|
(*s_etat_processus).erreur_systeme = |
|
d_es_allocation_memoire; |
|
return(NULL); |
|
} |
|
|
|
strcpy((unsigned char *) (*(*((struct_liste_chainee *) |
|
(*s_format_tmp).objet)).donnee).objet, |
|
"native*(*)"); |
|
} |
|
else |
|
{ |
|
if ((s_format_tmp = copie_objet(s_etat_processus, |
|
s_format, 'P')) == NULL) |
|
{ |
|
return(NULL); |
|
} |
|
} |
|
|
if ((chaine_formatee = formateur_fichier(s_etat_processus, |
if ((chaine_formatee = formateur_fichier(s_etat_processus, |
(*l_element_courant).donnee, s_format, |
(*l_element_courant).donnee, s_format_tmp, |
longueur, longueur_champ, format_sortie, type, |
longueur, longueur_champ, format_sortie, type, |
longueur_effective, recursivite, export_fichier)) |
longueur_effective, recursivite, export_fichier)) |
== NULL) |
== NULL) |
{ |
{ |
|
liberation(s_etat_processus, s_format_tmp); |
free(chaine); |
free(chaine); |
return(NULL); |
return(NULL); |
} |
} |
|
|
|
liberation(s_etat_processus, s_format_tmp); |
|
|
if ((chaine = realloc(chaine, |
if ((chaine = realloc(chaine, |
((size_t) (longueur_totale + (*longueur_effective))) |
((size_t) (longueur_totale + (*longueur_effective))) |
* sizeof(unsigned char))) == NULL) |
* sizeof(unsigned char))) == NULL) |
Line 3811 formateur_fichier(struct_processus *s_et
|
Line 3920 formateur_fichier(struct_processus *s_et
|
free(chaine_formatee); |
free(chaine_formatee); |
} |
} |
|
|
nombre_elements++; |
|
l_element_courant = (*l_element_courant).suivant; |
|
|
|
if (format_sortie != 'N') |
if (format_sortie != 'N') |
{ |
{ |
l_element_courant_format = |
l_element_courant_format = |
(*l_element_courant_format).suivant; |
(*l_element_courant_format).suivant; |
} |
} |
|
|
|
nombre_elements++; |
|
l_element_courant = (*l_element_courant).suivant; |
} |
} |
|
|
if (format_sortie != 'N') |
if (format_sortie != 'N') |
Line 4078 formateur_fichier(struct_processus *s_et
|
Line 4187 formateur_fichier(struct_processus *s_et
|
memcpy(&(chaine[longueur_totale]), tampon, 1); |
memcpy(&(chaine[longueur_totale]), tampon, 1); |
longueur_totale += 1; |
longueur_totale += 1; |
} |
} |
else if (longueur_totale < (((integer8) 1) << 16)) |
else |
{ |
{ |
longueur_totale++; |
longueur_totale++; |
|
|
for(i = 0; i < 7; i++) |
// i = { 0 (16 bits) 2 (32 bits) 6 (64 bits) } |
|
|
|
i = 0; |
|
|
|
for(;;) |
{ |
{ |
if ((longueur_totale < (((integer8) 1) << (8 * (i + 2)))) |
if ((longueur_totale < (((integer8) 1) << (8 * (i + 2)))) |
|| (i == 6)) |
|| (i == 6)) |
Line 4106 formateur_fichier(struct_processus *s_et
|
Line 4219 formateur_fichier(struct_processus *s_et
|
| ((i + 1) << 1)); |
| ((i + 1) << 1)); |
break; |
break; |
} |
} |
|
|
|
switch(i) |
|
{ |
|
case 0 : |
|
{ |
|
i = 2; |
|
break; |
|
} |
|
|
|
case 2 : |
|
{ |
|
i = 6; |
|
break; |
|
} |
|
} |
} |
} |
|
|
if ((chaine = realloc(chaine, (((size_t) longueur_totale) + 3) |
// i = 0 => +3 (16 bits) |
|
// i = 2 => +5 (32 bits) |
|
// i = 6 => +9 (64 bits) |
|
|
|
if ((chaine = realloc(chaine, (((size_t) longueur_totale) |
|
+ ((i == 0) ? 3 : ((i == 2) ? 5 : 9))) |
* sizeof(unsigned char))) == NULL) |
* sizeof(unsigned char))) == NULL) |
{ |
{ |
(*s_etat_processus).erreur_systeme = |
(*s_etat_processus).erreur_systeme = |
Line 4119 formateur_fichier(struct_processus *s_et
|
Line 4252 formateur_fichier(struct_processus *s_et
|
memcpy(&(chaine[longueur_totale]), tampon, 3); |
memcpy(&(chaine[longueur_totale]), tampon, 3); |
longueur_totale += 3; |
longueur_totale += 3; |
} |
} |
else if (longueur_totale < (((integer8) 1) << 32)) |
|
{ |
|
} |
|
|
|
__zone(); |
__zone(); |
(*longueur_effective) = longueur_totale; |
(*longueur_effective) = longueur_totale; |
Line 4303 formateur_fichier_reel(struct_processus
|
Line 4433 formateur_fichier_reel(struct_processus
|
real8 mantisse; |
real8 mantisse; |
real8 tampon_reel; |
real8 tampon_reel; |
|
|
|
integer8 i; |
integer8 tampon_entier; |
integer8 tampon_entier; |
|
|
long correction; |
long correction; |
Line 4315 formateur_fichier_reel(struct_processus
|
Line 4446 formateur_fichier_reel(struct_processus
|
unsigned char mode[3 + 1]; |
unsigned char mode[3 + 1]; |
unsigned char tampon[16 + 1]; |
unsigned char tampon[16 + 1]; |
|
|
unsigned long i; |
|
|
|
chaine = (unsigned char *) malloc((32 + 1) * sizeof(unsigned char)); |
chaine = (unsigned char *) malloc((32 + 1) * sizeof(unsigned char)); |
|
|
if (chaine == NULL) |
if (chaine == NULL) |
Line 4365 formateur_fichier_reel(struct_processus
|
Line 4494 formateur_fichier_reel(struct_processus
|
pow(10, (double) exposant); |
pow(10, (double) exposant); |
} |
} |
|
|
longueur_utile = longueur; |
longueur_utile = (long) longueur; |
longueur_utile_limite = 15; |
longueur_utile_limite = 15; |
|
|
if (longueur_utile > longueur_utile_limite) |
if (longueur_utile > longueur_utile_limite) |
Line 4479 formateur_fichier_reel(struct_processus
|
Line 4608 formateur_fichier_reel(struct_processus
|
|
|
sprintf(tampon, format, *((real8 *) valeur_numerique)); |
sprintf(tampon, format, *((real8 *) valeur_numerique)); |
|
|
i = strlen(tampon) - 1; |
i = (integer8) (strlen(tampon)) - 1; |
while(tampon[i] == '0') |
while(tampon[i] == '0') |
{ |
{ |
tampon[i] = 0; |
tampon[i] = 0; |
Line 4488 formateur_fichier_reel(struct_processus
|
Line 4617 formateur_fichier_reel(struct_processus
|
|
|
if (ds_imposition_separateur_decimal == d_faux) |
if (ds_imposition_separateur_decimal == d_faux) |
{ |
{ |
i = strlen(tampon) - 1; |
i = ((integer8) strlen(tampon)) - 1; |
if (tampon[i] == '.') |
if (tampon[i] == '.') |
{ |
{ |
tampon[i] = 0; |
tampon[i] = 0; |
Line 4503 formateur_fichier_reel(struct_processus
|
Line 4632 formateur_fichier_reel(struct_processus
|
{ |
{ |
if (strlen(chaine) > (size_t) longueur_champ) |
if (strlen(chaine) > (size_t) longueur_champ) |
{ |
{ |
for(i = 0; i < (unsigned long) longueur_champ; i++) |
for(i = 0; i < longueur_champ; i++) |
{ |
{ |
chaine[i] = '*'; |
chaine[i] = '*'; |
} |
} |
Line 5258 lecture_fichier_non_formate(struct_proce
|
Line 5387 lecture_fichier_non_formate(struct_proce
|
return(NULL); |
return(NULL); |
} |
} |
|
|
(*((integer8 *) (*s_objet).objet)) = 0; |
// Récupération des données avec extension de signe. |
|
|
for(i = 0; i < (signed) deplacement; i++) |
|
{ |
{ |
(*((integer8 *) (*s_objet).objet)) |= |
integer1 i1; |
((integer8) octets[i]) |
integer2 i2; |
<< (8 * ((((signed) deplacement) - 1) - i)); |
integer4 i4; |
|
integer8 i8; |
|
|
|
i1 = 0; |
|
i2 = 0; |
|
i4 = 0; |
|
i8 = 0; |
|
|
|
for(i = 0; i < (signed) deplacement; i++) |
|
{ |
|
switch(deplacement) |
|
{ |
|
case 1: |
|
i1 = (integer1) octets[0]; |
|
break; |
|
|
|
case 2: |
|
i2 |= (integer2) (((integer8) octets[i]) << |
|
(8 * ((((signed) deplacement) - 1) |
|
- i))); |
|
break; |
|
|
|
case 4: |
|
i4 |= (integer4) (((integer8) octets[i]) << |
|
(8 * ((((signed) deplacement) - 1) |
|
- i))); |
|
break; |
|
|
|
case 8: |
|
i8 |= (integer8) (((integer8) octets[i]) << |
|
(8 * ((((signed) deplacement) - 1) |
|
- i))); |
|
break; |
|
} |
|
} |
|
|
|
switch(deplacement) |
|
{ |
|
case 1: |
|
(*((integer8 *) (*s_objet).objet)) = |
|
(integer8) i1; |
|
break; |
|
|
|
case 2: |
|
(*((integer8 *) (*s_objet).objet)) = |
|
(integer8) i2; |
|
break; |
|
|
|
case 4: |
|
(*((integer8 *) (*s_objet).objet)) = |
|
(integer8) i4; |
|
break; |
|
|
|
case 8: |
|
(*((integer8 *) (*s_objet).objet)) = |
|
(integer8) i8; |
|
break; |
|
} |
} |
} |
|
|
break; |
break; |