/* ================================================================================ RPL/2 (R) version 4.0.19 Copyright (C) 1989-2010 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 'abort' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_abort(struct_processus *s_etat_processus) { struct timespec attente; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ABORT "); if ((*s_etat_processus).langue == 'F') { printf("(abandon du programme)\n\n"); printf(" Aucun argument\n"); } else { printf("(program abort)\n\n"); printf(" No argument\n"); } 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, 0) == d_erreur) { return; } } kill((*s_etat_processus).pid_processus_pere, SIGABORT); (*s_etat_processus).requete_arret = 'Y'; attente.tv_sec = 0; attente.tv_nsec = GRANULARITE_us * 1000; while((*s_etat_processus).var_volatile_requete_arret == 0) { nanosleep(&attente, NULL); INCR_GRANULARITE(attente.tv_nsec); } if ((*s_etat_processus).traitement_instruction_halt == d_vrai) { (*s_etat_processus).execution_pas_suivant = d_vrai; } return; } /* ================================================================================ Fonction 'and' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_and(struct_processus *s_etat_processus) { 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 AND "); if ((*s_etat_processus).langue == 'F') { printf("(opérateur et)\n\n"); } else { printf("(and operator)\n\n"); } printf(" 2: %s, %s\n", d_INT, d_REL); printf(" 1: %s, %s\n", d_INT, d_REL); printf("-> 1: %s\n\n", d_INT); printf(" 2: %s\n", d_BIN); printf(" 1: %s\n", d_BIN); printf("-> 1: %s\n\n", d_BIN); printf(" 2: %s\n", d_NOM); printf(" 1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL); printf("-> 1: %s\n\n", d_ALG); printf(" 2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL); printf(" 1: %s\n", d_NOM); printf("-> 1: %s\n\n", d_ALG); printf(" 2: %s\n", d_ALG); printf(" 1: %s\n", d_ALG); printf("-> 1: %s\n\n", d_ALG); printf(" 2: %s\n", d_RPN); printf(" 1: %s\n", d_RPN); printf("-> 1: %s\n", d_RPN); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = 0; 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; } /* -------------------------------------------------------------------------------- AND logique -------------------------------------------------------------------------------- */ if (((((*s_objet_argument_1).type == INT) || ((*s_objet_argument_1).type == REL)) && (((*s_objet_argument_2).type == INT) || ((*s_objet_argument_2).type == REL)))) { if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*s_objet_argument_1).type == INT) { if ((*s_objet_argument_2).type == INT) { if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) && ((*((integer8 *) (*s_objet_argument_2).objet)) != 0)) { (*((integer8 *) (*s_objet_resultat).objet)) = -1; } else { (*((integer8 *) (*s_objet_resultat).objet)) = 0; } } else { if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) && ((*((real8 *) (*s_objet_argument_2).objet)) != 0)) { (*((integer8 *) (*s_objet_resultat).objet)) = -1; } else { (*((integer8 *) (*s_objet_resultat).objet)) = 0; } } } else { if ((*s_objet_argument_2).type == INT) { if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) && ((*((integer8 *) (*s_objet_argument_2).objet)) != 0)) { (*((integer8 *) (*s_objet_resultat).objet)) = -1; } else { (*((integer8 *) (*s_objet_resultat).objet)) = 0; } } else { if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) && ((*((real8 *) (*s_objet_argument_2).objet)) != 0)) { (*((integer8 *) (*s_objet_resultat).objet)) = -1; } else { (*((integer8 *) (*s_objet_resultat).objet)) = 0; } } } } /* -------------------------------------------------------------------------------- AND binaire -------------------------------------------------------------------------------- */ else if (((*s_objet_argument_1).type == BIN) && ((*s_objet_argument_2).type == BIN)) { if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((logical8 *) (*s_objet_resultat).objet)) = (*((logical8 *) (*s_objet_argument_1).objet)) & (*((logical8 *) (*s_objet_argument_2).objet)); } /* -------------------------------------------------------------------------------- AND entre des arguments complexes -------------------------------------------------------------------------------- */ /* * Nom ou valeur numérique / Nom ou valeur numérique */ else if ((((*s_objet_argument_1).type == NOM) && (((*s_objet_argument_2).type == NOM) || ((*s_objet_argument_2).type == INT) || ((*s_objet_argument_2).type == REL))) || (((*s_objet_argument_2).type == NOM) && (((*s_objet_argument_1).type == INT) || ((*s_objet_argument_1).type == REL)))) { 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 = 0; (*((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 = 0; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_and; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "AND"); 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 = 0; (*((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; } /* * Nom ou valeur numérique / Expression */ 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))) { 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 = 0; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_and; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(4 * 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, "AND"); (*(*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_1).type == REL)) && (((*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 = 0; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_and; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(4 * 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, "AND"); (*(*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); liberation_maillon(s_etat_processus, 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); liberation_maillon(s_etat_processus, l_element_courant); (*l_element_precedent).suivant = (struct_liste_chainee *) (*s_copie_argument_1).objet; (*s_copie_argument_1).objet = NULL; 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 = 0; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_and; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "AND"); } /* -------------------------------------------------------------------------------- AND impossible -------------------------------------------------------------------------------- */ 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 'abs' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_abs(struct_processus *s_etat_processus) { logical1 erreur_memoire; real8 tampon_flottant; struct_liste_chainee *l_element_courant; struct_liste_chainee *l_element_precedent; struct_objet *s_copie_argument; struct_objet *s_objet_argument; struct_objet *s_objet_resultat; unsigned long i; unsigned long j; unsigned long k; unsigned long nombre_elements; void *accumulateur; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ABS "); if ((*s_etat_processus).langue == 'F') { printf("(norme)\n\n"); } else { printf("(norm)\n\n"); } printf(" 1: %s\n", d_INT); printf("-> 1: %s\n\n", d_INT); printf(" 1: %s, %s\n", d_REL, d_CPL); printf("-> 1: %s\n\n", d_REL); printf(" 1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX); printf("-> 1: %s\n\n", d_REL); printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX); printf("-> 1: %s\n\n", d_REL); printf(" 1: %s, %s\n", d_NOM, d_ALG); printf("-> 1: %s\n\n", d_ALG); printf(" 1: %s\n", d_RPN); printf("-> 1: %s\n", d_RPN); 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; } /* -------------------------------------------------------------------------------- Valeur absolue d'un entier -------------------------------------------------------------------------------- */ if ((*s_objet_argument).type == INT) { if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((integer8 *) (*s_objet_resultat).objet)) = abs((*((integer8 *) (*s_objet_argument).objet))); } /* -------------------------------------------------------------------------------- Valeur absolue d'un réel -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == REL) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((real8 *) (*s_objet_resultat).objet)) = fabs(*((real8 *) (*s_objet_argument).objet)); } /* -------------------------------------------------------------------------------- Valeur absolue d'un complexe -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == CPL) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*s_objet_resultat).type = REL; f77absc_(((struct_complexe16 *) (*s_objet_argument).objet), ((real8 *) (*s_objet_resultat).objet)); } /* -------------------------------------------------------------------------------- Norme de Frobenius d'un tableau -------------------------------------------------------------------------------- */ /* * Vecteur d'entiers */ else if ((*s_objet_argument).type == VIN) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((accumulateur = malloc((*(((struct_vecteur *) (*s_objet_argument).objet))).taille * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet))) .taille; i++) { ((real8 *) accumulateur)[i] = (real8) (((integer8 *) (*((struct_vecteur *) (*s_objet_argument).objet)) .tableau)[i] * ((integer8 *) (*((struct_vecteur *) (*s_objet_argument).objet)).tableau)[i]); } (*((real8 *) (*s_objet_resultat).objet)) = sqrt(sommation_vecteur_reel(accumulateur, &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille), &erreur_memoire)); if (erreur_memoire == d_vrai) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } free(accumulateur); } /* * Vecteur de réels */ else if ((*s_objet_argument).type == VRL) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((accumulateur = malloc((*(((struct_vecteur *) (*s_objet_argument).objet))).taille * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet))) .taille; i++) { ((real8 *) accumulateur)[i] = ((real8 *) (*((struct_vecteur *) (*s_objet_argument).objet)).tableau)[i] * ((real8 *) (*((struct_vecteur *) (*s_objet_argument).objet)).tableau)[i]; } (*((real8 *) (*s_objet_resultat).objet)) = sqrt(sommation_vecteur_reel(accumulateur, &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille), &erreur_memoire)); if (erreur_memoire == d_vrai) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } free(accumulateur); } /* * Vecteur de complexes */ else if ((*s_objet_argument).type == VCX) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((accumulateur = malloc((*(((struct_vecteur *) (*s_objet_argument).objet))).taille * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet))) .taille; i++) { f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_argument).objet)).tableau)[i]), &tampon_flottant); ((real8 *) accumulateur)[i] = (tampon_flottant * tampon_flottant); } (*((real8 *) (*s_objet_resultat).objet)) = sqrt(sommation_vecteur_reel(accumulateur, &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille), &erreur_memoire)); if (erreur_memoire == d_vrai) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } free(accumulateur); } /* * Matrice d'entiers */ else if ((*s_objet_argument).type == MIN) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((accumulateur = malloc((nombre_elements = (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument) .objet))).nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(k = 0, i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet))).nombre_lignes; i++) { for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_colonnes; j++) { ((real8 *) accumulateur)[k++] = ((integer8 **) (*((struct_matrice *) (*s_objet_argument).objet)).tableau)[i][j] * ((integer8 **) (*((struct_matrice *) (*s_objet_argument).objet)).tableau)[i][j]; } } (*((real8 *) (*s_objet_resultat).objet)) = sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements, &erreur_memoire)); if (erreur_memoire == d_vrai) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } free(accumulateur); } /* * Matrice de réels */ else if ((*s_objet_argument).type == MRL) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((accumulateur = malloc((nombre_elements = (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument) .objet))).nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(k = 0, i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet))).nombre_lignes; i++) { for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_colonnes; j++) { ((real8 *) accumulateur)[k++] = ((real8 **) (*((struct_matrice *) (*s_objet_argument).objet)).tableau)[i][j] * ((real8 **) (*((struct_matrice *) (*s_objet_argument).objet)).tableau)[i][j]; } } (*((real8 *) (*s_objet_resultat).objet)) = sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements, &erreur_memoire)); if (erreur_memoire == d_vrai) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } free(accumulateur); } /* * Matrice de complexes */ else if ((*s_objet_argument).type == MCX) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((accumulateur = malloc((nombre_elements = (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument) .objet))).nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(k = 0, i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet))).nombre_lignes; i++) { for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_colonnes; j++) { f77absc_(&(((struct_complexe16 **) (*((struct_matrice *) (*s_objet_argument).objet)).tableau)[i][j]), &tampon_flottant); ((real8 *) accumulateur)[k++] = (tampon_flottant * tampon_flottant); } } (*((real8 *) (*s_objet_resultat).objet)) = sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements, &erreur_memoire)); if (erreur_memoire == d_vrai) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } free(accumulateur); } /* -------------------------------------------------------------------------------- Valeur absolue d'un nom -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).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 = 0; (*((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; 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 = 1; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_abs; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "ABS"); 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 = 0; (*((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 = NULL; } /* -------------------------------------------------------------------------------- Valeur absolue d'une expression -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == ALG) || ((*s_objet_argument).type == RPN)) { if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_copie_argument).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; } 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 = 1; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_abs; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(4 * 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, "ABS"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Valeur absolue impossible à réaliser -------------------------------------------------------------------------------- */ else { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } liberation(s_etat_processus, s_objet_argument); return; } /* ================================================================================ Fonction 'arg' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_arg(struct_processus *s_etat_processus) { struct_liste_chainee *l_element_courant; struct_liste_chainee *l_element_precedent; struct_objet *s_copie_argument; struct_objet *s_objet_argument; struct_objet *s_objet_resultat; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ARG "); if ((*s_etat_processus).langue == 'F') { printf("(argument)\n\n"); } else { printf("(argument)\n\n"); } printf(" 1: %s, %s, %s\n", d_INT, d_REL, d_CPL); printf("-> 1: %s\n\n", d_REL); printf(" 1: %s, %s\n", d_NOM, d_ALG); printf("-> 1: %s\n\n", d_ALG); printf(" 1: %s\n", d_RPN); printf("-> 1: %s\n", d_RPN); 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; } /* -------------------------------------------------------------------------------- Argument d'un entier ou d'un réel -------------------------------------------------------------------------------- */ if (((*s_objet_argument).type == INT) || ((*s_objet_argument).type == REL)) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*s_objet_argument).type == INT) { if ((*((integer8 *) (*s_objet_argument).objet)) >= 0) { (*((real8 *) (*s_objet_resultat).objet)) = 0; } else { (*((real8 *) (*s_objet_resultat).objet)) = 4 * atan((real8) 1); } } else { if ((*((real8 *) (*s_objet_argument).objet)) >= 0) { (*((real8 *) (*s_objet_resultat).objet)) = 0; } else { (*((real8 *) (*s_objet_resultat).objet)) = 4 * atan((real8) 1); if (test_cfsf(s_etat_processus, 60) == d_faux) { conversion_radians_vers_degres(&(*((real8 *) (*s_objet_resultat).objet))); } } } } /* -------------------------------------------------------------------------------- Argument d'un complexe -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == CPL) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((real8 *) (*s_objet_resultat).objet)) = atan2((*((struct_complexe16 *) (*s_objet_argument).objet)) .partie_imaginaire, (*((struct_complexe16 *) (*s_objet_argument).objet)).partie_reelle); if (test_cfsf(s_etat_processus, 60) == d_faux) { conversion_radians_vers_degres(&(*((real8 *) (*s_objet_resultat).objet))); } } /* -------------------------------------------------------------------------------- Argument d'un nom -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).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 = 0; (*((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; 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 = 1; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_arg; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "ARG"); 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 = 0; (*((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 = NULL; } /* -------------------------------------------------------------------------------- Argument d'une expression -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == ALG) || ((*s_objet_argument).type == RPN)) { if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_copie_argument).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; } 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 = 1; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_arg; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(4 * 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, "ARG"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Réalisation impossible de la fonction argument -------------------------------------------------------------------------------- */ 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); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } /* ================================================================================ Fonction 'asin' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_asin(struct_processus *s_etat_processus) { real8 argument; struct_complexe16 registre; struct_liste_chainee *l_element_courant; struct_liste_chainee *l_element_precedent; struct_objet *s_copie_argument; struct_objet *s_objet_argument; struct_objet *s_objet_resultat; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ASIN "); if ((*s_etat_processus).langue == 'F') { printf("(arcsinus)\n\n"); } else { printf("(arcsine)\n\n"); } printf(" 1: %s, %s\n", d_INT, d_REL); printf("-> 1: %s, %s\n\n", d_REL, d_CPL); printf(" 1: %s\n", d_CPL); printf("-> 1: %s\n\n", d_CPL); printf(" 1: %s, %s\n", d_NOM, d_ALG); printf("-> 1: %s\n\n", d_ALG); printf(" 1: %s\n", d_RPN); printf("-> 1: %s\n", d_RPN); 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; } /* -------------------------------------------------------------------------------- Arcsinus d'un entier ou d'un réel -------------------------------------------------------------------------------- */ if (((*s_objet_argument).type == INT) || ((*s_objet_argument).type == REL)) { if ((*s_objet_argument).type == INT) { argument = (real8) (*((integer8 *) (*s_objet_argument).objet)); } else { argument = (*((real8 *) (*s_objet_argument).objet)); } if ((argument >= -1) && (argument <= 1)) { /* * Résultat réel */ if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((real8 *) (*s_objet_resultat).objet)) = asin(argument); if (test_cfsf(s_etat_processus, 60) == d_faux) { conversion_radians_vers_degres((real8 *) (*s_objet_resultat).objet); } } else { /* * Résultat complexe */ registre.partie_reelle = argument; registre.partie_imaginaire = 0; if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77asin_(®istre, (struct_complexe16 *) (*s_objet_resultat).objet); } } /* -------------------------------------------------------------------------------- Arcsinus d'un complexe -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == CPL) { if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77asin_((struct_complexe16 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet); } /* -------------------------------------------------------------------------------- Arcsinus d'un nom -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).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 = 0; (*((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; 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 = 1; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_asin; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "ASIN"); 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 = 0; (*((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 = NULL; } /* -------------------------------------------------------------------------------- Arcsinus d'une expression -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == ALG) || ((*s_objet_argument).type == RPN)) { if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_copie_argument).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; } 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 = 1; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_asin; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(5 * 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, "ASIN"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Réalisation impossible de la fonction arcsinus -------------------------------------------------------------------------------- */ 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); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } /* ================================================================================ Fonction 'acos' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_acos(struct_processus *s_etat_processus) { real8 argument; struct_complexe16 registre; struct_liste_chainee *l_element_courant; struct_liste_chainee *l_element_precedent; struct_objet *s_copie_argument; struct_objet *s_objet_argument; struct_objet *s_objet_resultat; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ACOS "); if ((*s_etat_processus).langue == 'F') { printf("(arccosinus)\n\n"); } else { printf("(arccosine)\n\n"); } printf(" 1: %s, %s\n", d_INT, d_REL); printf("-> 1: %s, %s\n\n", d_REL, d_CPL); printf(" 1: %s\n", d_CPL); printf("-> 1: %s\n\n", d_CPL); printf(" 1: %s, %s\n", d_NOM, d_ALG); printf("-> 1: %s\n\n", d_ALG); printf(" 1: %s\n", d_RPN); printf("-> 1: %s\n", d_RPN); 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; } /* -------------------------------------------------------------------------------- Arccossinus d'un entier ou d'un réel -------------------------------------------------------------------------------- */ if (((*s_objet_argument).type == INT) || ((*s_objet_argument).type == REL)) { if ((*s_objet_argument).type == INT) { argument = (real8) (*((integer8 *) (*s_objet_argument).objet)); } else { argument = (*((real8 *) (*s_objet_argument).objet)); } if ((argument >= -1) && (argument <= 1)) { /* * Résultat réel */ if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((real8 *) (*s_objet_resultat).objet)) = acos(argument); if (test_cfsf(s_etat_processus, 60) == d_faux) { conversion_radians_vers_degres((real8 *) (*s_objet_resultat).objet); } } else { /* * Résultat complexe */ registre.partie_reelle = argument; registre.partie_imaginaire = 0; if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77acos_(®istre, (struct_complexe16 *) (*s_objet_resultat).objet); } } /* -------------------------------------------------------------------------------- Arccossinus d'un complexe -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == CPL) { if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77acos_((struct_complexe16 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet); } /* -------------------------------------------------------------------------------- Arccossinus d'un nom -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).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 = 0; (*((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; 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 = 1; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_acos; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "ACOS"); 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 = 0; (*((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 = NULL; } /* -------------------------------------------------------------------------------- Arccossinus d'une expression -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == ALG) || ((*s_objet_argument).type == RPN)) { if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_copie_argument).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; } 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 = 1; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_acos; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(5 * 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, "ACOS"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Réalisation impossible de la fonction arccosinus -------------------------------------------------------------------------------- */ 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); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } /* ================================================================================ Fonction 'atan' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_atan(struct_processus *s_etat_processus) { real8 argument; integer4 erreur; struct_liste_chainee *l_element_courant; struct_liste_chainee *l_element_precedent; struct_objet *s_copie_argument; struct_objet *s_objet_argument; struct_objet *s_objet_resultat; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n ATAN "); if ((*s_etat_processus).langue == 'F') { printf("(arctangente)\n\n"); } else { printf("(arctangent)\n\n"); } printf(" 1: %s, %s\n", d_INT, d_REL); printf("-> 1: %s, %s\n\n", d_REL, d_CPL); printf(" 1: %s\n", d_CPL); printf("-> 1: %s\n\n", d_CPL); printf(" 1: %s, %s\n", d_NOM, d_ALG); printf("-> 1: %s\n\n", d_ALG); printf(" 1: %s\n", d_RPN); printf("-> 1: %s\n", d_RPN); 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; } /* -------------------------------------------------------------------------------- Arctangente d'un entier ou d'un réel -------------------------------------------------------------------------------- */ if (((*s_objet_argument).type == INT) || ((*s_objet_argument).type == REL)) { if ((*s_objet_argument).type == INT) { argument = (real8) (*((integer8 *) (*s_objet_argument).objet)); } else { argument = (*((real8 *) (*s_objet_argument).objet)); } if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((real8 *) (*s_objet_resultat).objet)) = atan(argument); if (test_cfsf(s_etat_processus, 60) == d_faux) { conversion_radians_vers_degres((real8 *) (*s_objet_resultat).objet); } } /* -------------------------------------------------------------------------------- Arctangente d'un complexe -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == CPL) { if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77atan_((struct_complexe16 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { liberation(s_etat_processus, s_objet_argument); liberation(s_etat_processus, s_objet_resultat); free(s_objet_resultat); (*s_etat_processus).exception = d_ep_division_par_zero; return; } } /* -------------------------------------------------------------------------------- Arctangente d'un nom -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).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 = 0; (*((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; 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 = 1; (*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .fonction = instruction_atan; if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet)) .nom_fonction, "ATAN"); 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 = 0; (*((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 = NULL; } /* -------------------------------------------------------------------------------- Arctangente d'une expression -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == ALG) || ((*s_objet_argument).type == RPN)) { if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument, 'N')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } l_element_courant = (struct_liste_chainee *) (*s_copie_argument).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; } 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 = 1; (*((struct_fonction *) (*(*(*l_element_precedent).suivant) .donnee).objet)).fonction = instruction_atan; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).donnee).objet)).nom_fonction = malloc(5 * 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, "ATAN"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Réalisation impossible de la fonction arctangente -------------------------------------------------------------------------------- */ 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); if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet_resultat) == d_erreur) { return; } return; } // vim: ts=4