/* ================================================================================ RPL/2 (R) version 4.1.14 Copyright (C) 1989-2013 Dr. BERTRAND Joël This file is part of RPL/2. RPL/2 is free software; you can redistribute it and/or modify it under the terms of the CeCILL V2 License as published by the french CEA, CNRS and INRIA. RPL/2 is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License for more details. You should have received a copy of the CeCILL License along with RPL/2. If not, write to info@cecill.info. ================================================================================ */ #include "rpl-conv.h" /* ================================================================================ Fonction 'xroot' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_xroot(struct_processus *s_etat_processus) { real8 argument; real8 module; struct_liste_chainee *l_element_courant; struct_liste_chainee *l_element_precedent; struct_objet *s_copie_argument_1; struct_objet *s_copie_argument_2; struct_objet *s_objet_argument_1; struct_objet *s_objet_argument_2; struct_objet *s_objet_resultat; unsigned long nombre_elements; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n XROOT "); if ((*s_etat_processus).langue == 'F') { printf("(racine n-ième)\n\n"); } else { printf("(Nth root)\n\n"); } printf(" 2: %s, %s, %s\n", d_INT, d_REL, d_CPL); printf(" 1: %s\n", d_INT); printf("-> 1: %s, %s\n\n", d_REL, d_CPL); printf(" 2: %s, %s, %s, %s, %s, %s\n", d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN); printf(" 1: %s, %s, %s, %s, %s, %s\n", d_INT, d_REL, d_CPL, d_NOM, d_ALG, d_RPN); printf("-> 1: %s, %s\n", d_ALG, d_RPN); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = 2; return; } if (test_cfsf(s_etat_processus, 31) == d_vrai) { if (empilement_pile_last(s_etat_processus, 2) == d_erreur) { return; } } if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_argument_1) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_argument_2) == d_erreur) { liberation(s_etat_processus, s_objet_argument_1); (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } /* -------------------------------------------------------------------------------- Racines n-ièmes de scalaires -------------------------------------------------------------------------------- */ if (((*s_objet_argument_1).type == INT) && ((*s_objet_argument_2).type == INT)) { if ((*((integer8 *) (*s_objet_argument_1).objet)) <= 0) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if (((*((integer8 *) (*s_objet_argument_2).objet)) < 0) && (((*((integer8 *) (*s_objet_argument_1).objet)) % 2) == 0)) { /* * Résultat Y^(1/X) complexe si X impair et Y négatif */ if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } module = abs((real8) (*((integer8 *) (*s_objet_argument_2).objet))); argument = ((*((integer8 *) (*s_objet_argument_2).objet)) >= 0) ? 0 : (4 * atan((double) 1)); argument /= ((double) (*((integer8 *) (*s_objet_argument_1) .objet))); module = pow(module, ((double) 1) / ((double) (*((integer8 *) (*s_objet_argument_1).objet)))); (*((complex16 *) (*s_objet_resultat).objet)).partie_reelle = module * cos(argument); (*((complex16 *) (*s_objet_resultat).objet)).partie_imaginaire = module * sin(argument); } else { /* * Résultat réel */ if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*((integer8 *) (*s_objet_argument_2).objet)) >= 0) { (*((real8 *) (*s_objet_resultat).objet)) = pow(((double) (*((integer8 *) (*s_objet_argument_2).objet))), ((double) 1) / ((double) (*((integer8 *) (*s_objet_argument_1).objet)))); } else { (*((real8 *) (*s_objet_resultat).objet)) = -pow(((double) -(*((integer8 *) (*s_objet_argument_2).objet))), ((double) 1) / ((double) (*((integer8 *) (*s_objet_argument_1).objet)))); } } } else if (((*s_objet_argument_1).type == INT) && ((*s_objet_argument_2).type == REL)) { if ((*((integer8 *) (*s_objet_argument_1).objet)) <= 0) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if (((*((real8 *) (*s_objet_argument_2).objet)) < 0) && (((*((integer8 *) (*s_objet_argument_1).objet)) % 2) == 0)) { /* * Résultat Y^(1/X) complexe si X impair et Y négatif */ if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } module = abs((*((real8 *) (*s_objet_argument_2).objet))); argument = ((*((real8 *) (*s_objet_argument_2).objet)) >= 0) ? 0 : (4 * atan((double) 1)); argument /= ((double) (*((integer8 *) (*s_objet_argument_1) .objet))); module = pow(module, ((double) 1) / ((double) (*((integer8 *) (*s_objet_argument_1).objet)))); (*((complex16 *) (*s_objet_resultat).objet)).partie_reelle = module * cos(argument); (*((complex16 *) (*s_objet_resultat).objet)).partie_imaginaire = module * sin(argument); } else { /* * Résultat réel */ if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*((real8 *) (*s_objet_argument_2).objet)) >= 0) { (*((real8 *) (*s_objet_resultat).objet)) = pow( (*((real8 *) (*s_objet_argument_2).objet)), ((double) 1) / ((double) (*((integer8 *) (*s_objet_argument_1).objet)))); } else { (*((real8 *) (*s_objet_resultat).objet)) = -pow( -(*((real8 *) (*s_objet_argument_2).objet)), ((double) 1) / ((double) (*((integer8 *) (*s_objet_argument_1).objet)))); } } } else if (((*s_objet_argument_1).type == INT) && ((*s_objet_argument_2).type == CPL)) { if ((*((integer8 *) (*s_objet_argument_1).objet)) <= 0) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77absc_(((struct_complexe16 *) (*s_objet_argument_2).objet), &module); argument = atan2((*((struct_complexe16 *) (*s_objet_argument_2).objet)) .partie_imaginaire, (*((struct_complexe16 *) (*s_objet_argument_2).objet)).partie_reelle); argument /= ((double) (*((integer8 *) (*s_objet_argument_1).objet))); module = pow(module, ((double) 1) / ((double) (*((integer8 *) (*s_objet_argument_1).objet)))); (*((complex16 *) (*s_objet_resultat).objet)).partie_reelle = module * cos(argument); (*((complex16 *) (*s_objet_resultat).objet)).partie_imaginaire = module * sin(argument); } /* -------------------------------------------------------------------------------- Résultat sous forme d'expression algébrique -------------------------------------------------------------------------------- */ else if ((((*s_objet_argument_2).type == NOM) && (((*s_objet_argument_1).type == NOM) || ((*s_objet_argument_1).type == INT))) || ((((*s_objet_argument_2).type == INT) || ((*s_objet_argument_2).type == REL) || ((*s_objet_argument_2).type == CPL)) && ((*s_objet_argument_1).type == NOM))) { if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*s_objet_resultat).objet = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*s_objet_resultat).objet; if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nombre_arguments = 2; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_vers_niveau_superieur; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "<<"); if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; (*l_element_courant).donnee = s_objet_argument_2; if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; (*l_element_courant).donnee = s_objet_argument_1; if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nombre_arguments = 2; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_xroot; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "XROOT"); if (((*l_element_courant).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (*l_element_courant).suivant; if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nombre_arguments = 2; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_vers_niveau_inferieur; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, ">>"); (*l_element_courant).suivant = NULL; s_objet_argument_1 = NULL; s_objet_argument_2 = NULL; } /* * Expression / Nom ou valeur numérique */ else if ((((*s_objet_argument_1).type == ALG) || ((*s_objet_argument_1).type == RPN)) && (((*s_objet_argument_2).type == NOM) || ((*s_objet_argument_2).type == INT) || ((*s_objet_argument_2).type == REL) || ((*s_objet_argument_2).type == CPL))) { nombre_elements = 0; l_element_courant = (struct_liste_chainee *) (*s_objet_argument_1).objet; while(l_element_courant != NULL) { nombre_elements++; l_element_courant = (*l_element_courant).suivant; } if (nombre_elements == 2) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if ((s_objet_resultat = copie_objet(s_etat_processus, s_objet_argument_1, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_objet_resultat).objet; l_element_precedent = l_element_courant; l_element_courant = (*l_element_courant).suivant; if (((*l_element_precedent).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*(*l_element_precedent).suivant).donnee = s_objet_argument_2; (*(*l_element_precedent).suivant).suivant = l_element_courant; while((*l_element_courant).suivant != NULL) { l_element_precedent = l_element_courant; l_element_courant = (*l_element_courant).suivant; } if (((*l_element_precedent).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*(*l_element_precedent).suivant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).nombre_arguments = 2; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_xroot; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction, "XROOT"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_argument_2 = NULL; } /* * Expression / Nom ou valeur numérique */ else if ((((*s_objet_argument_1).type == NOM) || ((*s_objet_argument_1).type == INT)) && (((*s_objet_argument_2).type == ALG) || ((*s_objet_argument_2).type == RPN))) { nombre_elements = 0; l_element_courant = (struct_liste_chainee *) (*s_objet_argument_2).objet; while(l_element_courant != NULL) { nombre_elements++; l_element_courant = (*l_element_courant).suivant; } if (nombre_elements == 2) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if ((s_objet_resultat = copie_objet(s_etat_processus, s_objet_argument_2, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_objet_resultat).objet; l_element_precedent = l_element_courant; while((*l_element_courant).suivant != NULL) { l_element_precedent = l_element_courant; l_element_courant = (*l_element_courant).suivant; } if (((*l_element_precedent).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*(*l_element_precedent).suivant).donnee = s_objet_argument_1; l_element_precedent = (*l_element_precedent).suivant; if (((*l_element_precedent).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*(*l_element_precedent).suivant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).nombre_arguments = 2; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_xroot; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction, "XROOT"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_argument_1 = NULL; } /* * Expression / Expression */ else if ((((*s_objet_argument_1).type == ALG) && ((*s_objet_argument_2).type == ALG)) || (((*s_objet_argument_1).type == RPN) && ((*s_objet_argument_2).type == RPN))) { nombre_elements = 0; l_element_courant = (struct_liste_chainee *) (*s_objet_argument_1).objet; while(l_element_courant != NULL) { nombre_elements++; l_element_courant = (*l_element_courant).suivant; } if (nombre_elements == 2) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } nombre_elements = 0; l_element_courant = (struct_liste_chainee *) (*s_objet_argument_2).objet; while(l_element_courant != NULL) { nombre_elements++; l_element_courant = (*l_element_courant).suivant; } if (nombre_elements == 2) { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } if ((s_copie_argument_1 = copie_objet(s_etat_processus, s_objet_argument_1, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((s_copie_argument_2 = copie_objet(s_etat_processus, s_objet_argument_2, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_copie_argument_1).objet; (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *) (*s_copie_argument_1).objet)).suivant; liberation(s_etat_processus, (*l_element_courant).donnee); free(l_element_courant); l_element_courant = (struct_liste_chainee *) (*s_copie_argument_2).objet; l_element_precedent = l_element_courant; s_objet_resultat = s_copie_argument_2; while((*l_element_courant).suivant != NULL) { l_element_precedent = l_element_courant; l_element_courant = (*l_element_courant).suivant; } liberation(s_etat_processus, (*l_element_courant).donnee); free(l_element_courant); (*l_element_precedent).suivant = (struct_liste_chainee *) (*s_copie_argument_1).objet; free(s_copie_argument_1); l_element_courant = (*l_element_precedent).suivant; while((*l_element_courant).suivant != NULL) { l_element_precedent = l_element_courant; l_element_courant = (*l_element_courant).suivant; } if (((*l_element_precedent).suivant = allocation_maillon(s_etat_processus)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*(*l_element_precedent).suivant).suivant = l_element_courant; l_element_courant = (*l_element_precedent).suivant; if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nombre_arguments = 2; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_xroot; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "XROOT"); } else { liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } liberation(s_etat_processus, s_objet_argument_1); liberation(s_etat_processus, s_objet_argument_2); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } /* ================================================================================ Fonction 'xcol' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_xcol(struct_processus *s_etat_processus) { struct_objet *s_objet_argument; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n XCOL "); if ((*s_etat_processus).langue == 'F') { printf("(définition de la colonne statistique X)\n\n"); } else { printf("(definition of statistical X column)\n\n"); } printf(" 1: %s\n", d_INT); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = -1; return; } if (test_cfsf(s_etat_processus, 31) == d_vrai) { if (empilement_pile_last(s_etat_processus, 1) == d_erreur) { return; } } if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_argument) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((*s_objet_argument).type == INT) { if ((*((integer8 *) (*s_objet_argument).objet)) <= 0) { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_argument_invalide; return; } (*s_etat_processus).colonne_statistique_1 = (*((integer8 *) (*s_objet_argument).objet)); } else { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } liberation(s_etat_processus, s_objet_argument); return; } // vim: ts=4