rpl/src/instructions_f2.c - diff

Return to instructions_f2.c CVS log

Up to [local] / rpl / src

Diff for /rpl/src/instructions_f2.c between versions 1.1.1.1 and 1.68

version 1.1.1.1, 2010/01/26 15:22:44	version 1.68, 2020/01/10 11:15:45
Line 1	Line 1
/*	/*
================================================================================	================================================================================
RPL/2 (R) version 4.0.9	RPL/2 (R) version 4.1.32
Copyright (C) 1989-2010 Dr. BERTRAND Joël	Copyright (C) 1989-2020 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 164 instruction_fleche_array(struct_processu	Line 164 instruction_fleche_array(struct_processu
struct_objet *s_objet;	struct_objet *s_objet;
struct_objet *s_objet_elementaire;	struct_objet *s_objet_elementaire;

unsigned long i;	integer8 i;
unsigned long j;	integer8 j;
unsigned long nombre_colonnes;	integer8 nombre_colonnes;
unsigned long nombre_lignes;	integer8 nombre_lignes;
unsigned long nombre_dimensions;	integer8 nombre_dimensions;
unsigned long nombre_termes;	integer8 nombre_termes;

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

Line 343 instruction_fleche_array(struct_processu	Line 343 instruction_fleche_array(struct_processu
}	}

if (((((struct_vecteur ) (*s_objet).objet)).tableau =	if (((((struct_vecteur ) (*s_objet).objet)).tableau =
malloc(nombre_lignes * sizeof(integer8))) == NULL)	malloc(((size_t) nombre_lignes) * sizeof(integer8)))
	== NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 358 instruction_fleche_array(struct_processu	Line 359 instruction_fleche_array(struct_processu
}	}

if (((((struct_vecteur ) (*s_objet).objet)).tableau =	if (((((struct_vecteur ) (*s_objet).objet)).tableau =
malloc(nombre_lignes * sizeof(real8))) == NULL)	malloc(((size_t) nombre_lignes) * sizeof(real8))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 373 instruction_fleche_array(struct_processu	Line 374 instruction_fleche_array(struct_processu
}	}

if (((((struct_vecteur ) (*s_objet).objet)).tableau =	if (((((struct_vecteur ) (*s_objet).objet)).tableau =
malloc(nombre_lignes * sizeof(struct_complexe16)))	malloc(((size_t) nombre_lignes) *
== NULL)	sizeof(struct_complexe16))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 474 instruction_fleche_array(struct_processu	Line 475 instruction_fleche_array(struct_processu
}	}

if (((((struct_matrice ) (*s_objet).objet)).tableau =	if (((((struct_matrice ) (*s_objet).objet)).tableau =
malloc(nombre_lignes * sizeof(integer8 *))) == NULL)	malloc(((size_t) nombre_lignes) * sizeof(integer8 *)))
	== NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 490 instruction_fleche_array(struct_processu	Line 492 instruction_fleche_array(struct_processu
}	}

if (((((struct_matrice ) (*s_objet).objet)).tableau =	if (((((struct_matrice ) (*s_objet).objet)).tableau =
malloc(nombre_lignes * sizeof(real8 *))) == NULL)	malloc(((size_t) nombre_lignes) * sizeof(real8 *))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 506 instruction_fleche_array(struct_processu	Line 508 instruction_fleche_array(struct_processu
}	}

if (((((struct_matrice ) (*s_objet).objet)).tableau =	if (((((struct_matrice ) (*s_objet).objet)).tableau =
malloc(nombre_lignes * sizeof(struct_complexe16 *)))	malloc(((size_t) nombre_lignes) *
== NULL)	sizeof(struct_complexe16 *))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 524 instruction_fleche_array(struct_processu	Line 526 instruction_fleche_array(struct_processu
{	{
if ((((integer8 *) (((struct_matrice *)	if ((((integer8 *) (((struct_matrice *)
(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]	(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
= malloc(nombre_colonnes * sizeof(integer8))) == NULL)	= malloc(((size_t) nombre_colonnes) *
	sizeof(integer8))) == NULL)
{	{
(*s_etat_processus).erreur_systeme =	(*s_etat_processus).erreur_systeme =
d_es_allocation_memoire;	d_es_allocation_memoire;
Line 535 instruction_fleche_array(struct_processu	Line 538 instruction_fleche_array(struct_processu
{	{
if ((((real8 *) (((struct_matrice *)	if ((((real8 *) (((struct_matrice *)
(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]	(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
= malloc(nombre_colonnes * sizeof(real8))) == NULL)	= malloc(((size_t) nombre_colonnes) * sizeof(real8)))
	== NULL)
{	{
(*s_etat_processus).erreur_systeme =	(*s_etat_processus).erreur_systeme =
d_es_allocation_memoire;	d_es_allocation_memoire;
Line 546 instruction_fleche_array(struct_processu	Line 550 instruction_fleche_array(struct_processu
{	{
if ((((struct_complexe16 *) (((struct_matrice *)	if ((((struct_complexe16 *) (((struct_matrice *)
(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]	(*s_objet).objet)).tableau)[nombre_lignes - (i + 1)]
= malloc(nombre_colonnes * sizeof(struct_complexe16)))	= malloc(((size_t) nombre_colonnes)
== NULL)	* sizeof(struct_complexe16))) == NULL)
{	{
(*s_etat_processus).erreur_systeme =	(*s_etat_processus).erreur_systeme =
d_es_allocation_memoire;	d_es_allocation_memoire;
Line 729 instruction_fleche_str(struct_processus	Line 733 instruction_fleche_str(struct_processus
struct_objet *s_objet_argument;	struct_objet *s_objet_argument;
struct_objet *s_objet_resultat;	struct_objet *s_objet_resultat;

	unsigned char *ligne;
	unsigned char *ptr_e;
	unsigned char *ptr_l;

	integer8 caracteres_echappement;

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

if ((*s_etat_processus).affichage_arguments == 'Y')	if ((*s_etat_processus).affichage_arguments == 'Y')
Line 781 instruction_fleche_str(struct_processus	Line 791 instruction_fleche_str(struct_processus
return;	return;
}	}

(s_objet_resultat).objet = (void ) formateur(s_etat_processus, 0,	ligne = formateur(s_etat_processus, 0, s_objet_argument);
s_objet_argument);	caracteres_echappement = 0;

	// Reconstitution des caractères d'échappement

	ptr_l = ligne;

	while((*ptr_l) != d_code_fin_chaine)
	{
	switch(*ptr_l)
	{
	case '\"':
	case '\b':
	case '\n':
	case '\t':
	case '\\':
	{
	caracteres_echappement++;
	break;
	}
	}

	ptr_l++;
	}

if ((*s_objet_resultat).objet == NULL)	if (((*s_objet_resultat).objet = malloc((strlen(ligne) + 1 +
	((size_t) caracteres_echappement)) * sizeof(unsigned char)))
	== NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
}	}

	ptr_l = ligne;
	ptr_e = (*s_objet_resultat).objet;

	while((*ptr_l) != d_code_fin_chaine)
	{
	switch(*ptr_l)
	{
	case '\\':
	{
	(*ptr_e) = '\\';
	(*(++ptr_e)) = '\\';
	break;
	}

	case '\"':
	{
	(*ptr_e) = '\\';
	(*(++ptr_e)) = '\"';
	break;
	}

	case '\b':
	{
	(*ptr_e) = '\\';
	(*(++ptr_e)) = 'b';
	break;
	}

	case '\n':
	{
	(*ptr_e) = '\\';
	(*(++ptr_e)) = 'n';
	break;
	}

	case '\t':
	{
	(*ptr_e) = '\\';
	(*(++ptr_e)) = 't';
	break;
	}

	default:
	{
	(ptr_e) = (ptr_l);
	break;
	}
	}

	ptr_l++;
	ptr_e++;
	}

	(*ptr_e) = d_code_fin_chaine;
	free(ligne);

liberation(s_etat_processus, s_objet_argument);	liberation(s_etat_processus, s_objet_argument);

if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),	if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
Line 823 instruction_fft(struct_processus *s_etat	Line 913 instruction_fft(struct_processus *s_etat
integer4 nombre_colonnes;	integer4 nombre_colonnes;
integer4 nombre_lignes;	integer4 nombre_lignes;

logical1 presence_longueur_fft;	integer8 longueur_fft_signee;

long longueur_fft_signee;	logical1 presence_longueur_fft;

struct_complexe16 *matrice_f77;	struct_complexe16 *matrice_f77;

Line 833 instruction_fft(struct_processus *s_etat	Line 923 instruction_fft(struct_processus *s_etat
struct_objet *s_objet_longueur_fft;	struct_objet *s_objet_longueur_fft;
struct_objet *s_objet_resultat;	struct_objet *s_objet_resultat;

unsigned long i;	integer8 i;
unsigned long j;	integer8 j;
unsigned long k;	integer8 k;
unsigned long longueur_fft;	integer8 longueur_fft;

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

Line 950 instruction_fft(struct_processus *s_etat	Line 1040 instruction_fft(struct_processus *s_etat
{	{
if (presence_longueur_fft == d_faux)	if (presence_longueur_fft == d_faux)
{	{
longueur_fft = pow(2, (integer4) ceil(log((real8)	longueur_fft = (integer8) pow(2, ceil(log((real8)
(((struct_vecteur )	(((struct_vecteur )
(*s_objet_argument).objet)).taille) / log((real8) 2)));	(*s_objet_argument).objet)).taille) / log((real8) 2)));

if ((longueur_fft / ((real8) (((struct_vecteur )	if ((((real8) longueur_fft) / ((real8) (((struct_vecteur )
(*s_objet_argument).objet)).taille)) == 2)	(*s_objet_argument).objet)).taille)) == 2)
{	{
longueur_fft /= 2;	longueur_fft /= 2;
}	}
}	}

if ((matrice_f77 = malloc(longueur_fft *	if ((matrice_f77 = malloc(((size_t) longueur_fft) *
sizeof(struct_complexe16))) == NULL)	sizeof(struct_complexe16))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
Line 1011 instruction_fft(struct_processus *s_etat	Line 1101 instruction_fft(struct_processus *s_etat
}	}

nombre_lignes = 1;	nombre_lignes = 1;
nombre_colonnes = longueur_fft;	nombre_colonnes = (integer4) longueur_fft;
inverse = 0;	inverse = 0;

dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);	dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
Line 1048 instruction_fft(struct_processus *s_etat	Line 1138 instruction_fft(struct_processus *s_etat
{	{
if (presence_longueur_fft == d_faux)	if (presence_longueur_fft == d_faux)
{	{
longueur_fft = pow(2, (integer4) ceil(log((real8)	longueur_fft = (integer8) pow(2, ceil(log((real8)
(((struct_matrice )	(((struct_matrice )
(*s_objet_argument).objet)).nombre_colonnes) /	(*s_objet_argument).objet)).nombre_colonnes) /
log((real8) 2)));	log((real8) 2)));

if ((longueur_fft / ((real8) (((struct_matrice )	if ((((real8) longueur_fft) / ((real8) (((struct_matrice )
(*s_objet_argument).objet)).nombre_colonnes)) == 2)	(*s_objet_argument).objet)).nombre_colonnes)) == 2)
{	{
longueur_fft /= 2;	longueur_fft /= 2;
}	}
}	}

if ((matrice_f77 = malloc(longueur_fft *	if ((matrice_f77 = malloc(((size_t) longueur_fft) * ((size_t)
(((struct_matrice ) (*s_objet_argument).objet))	(((struct_matrice ) (*s_objet_argument).objet))
.nombre_lignes * sizeof(struct_complexe16))) == NULL)	.nombre_lignes) * sizeof(struct_complexe16))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 1138 instruction_fft(struct_processus *s_etat	Line 1228 instruction_fft(struct_processus *s_etat
}	}
}	}

nombre_lignes = (((struct_matrice ) (*s_objet_argument).objet))	nombre_lignes = (integer4) (((struct_matrice )
.nombre_lignes;	(*s_objet_argument).objet)).nombre_lignes;
nombre_colonnes = longueur_fft;	nombre_colonnes = (integer4) longueur_fft;
inverse = 0;	inverse = 0;

dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);	dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
Line 1168 instruction_fft(struct_processus *s_etat	Line 1258 instruction_fft(struct_processus *s_etat
longueur_fft;	longueur_fft;

if (((((struct_matrice ) (*s_objet_resultat).objet)).tableau =	if (((((struct_matrice ) (*s_objet_resultat).objet)).tableau =
malloc((((struct_matrice ) (*s_objet_resultat).objet))	malloc(((size_t) (((struct_matrice )
.nombre_lignes * sizeof(struct_complexe16 *))) == NULL)	(*s_objet_resultat).objet)).nombre_lignes)
	* sizeof(struct_complexe16 *))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
return;	return;
Line 1180 instruction_fft(struct_processus *s_etat	Line 1271 instruction_fft(struct_processus *s_etat
{	{
if ((((struct_complexe16 *) (((struct_matrice *)	if ((((struct_complexe16 *) (((struct_matrice *)
(*s_objet_resultat).objet)).tableau)[i] =	(*s_objet_resultat).objet)).tableau)[i] =
malloc((((struct_matrice )	malloc(((size_t) (((struct_matrice )
(s_objet_resultat).objet)).nombre_colonnes	(s_objet_resultat).objet)).nombre_colonnes)
sizeof(struct_complexe16))) == NULL)	sizeof(struct_complexe16))) == NULL)
{	{
(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;	(*s_etat_processus).erreur_systeme = d_es_allocation_memoire;

CVSweb interface <joel.bertrand@systella.fr>

Removed from v.1.1.1.1
changed lines
	Added in v.1.68