/* ================================================================================ RPL/2 (R) version 4.1.32 Copyright (C) 1989-2020 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 'inv' ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_inv(struct_processus *s_etat_processus) { real8 dividende_reel; real8 diviseur_reel; 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 INV "); if ((*s_etat_processus).langue == 'F') { printf("(inversion)\n\n"); } else { printf("(inversion)\n\n"); } printf(" 1: %s, %s\n", d_INT, d_REL); printf("-> 1: %s\n\n", d_REL); printf(" 1: %s\n", d_CPL); printf("-> 1: %s\n\n", d_CPL); printf(" 1: %s, %s\n", d_MIN, d_MRL); printf("-> 1: %s\n\n", d_MRL); printf(" 1: %s\n", d_MCX); printf("-> 1: %s\n\n", d_MCX); 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; } /* -------------------------------------------------------------------------------- Inversion donnant un résultat 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) { diviseur_reel = (real8) (*((integer8 *) (*s_objet_argument).objet)); } else { diviseur_reel = (*((real8 *) (*s_objet_argument).objet)); } if ((diviseur_reel == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai)) { liberation(s_etat_processus, s_objet_argument); free(s_objet_resultat); (*s_etat_processus).exception = d_ep_division_par_zero; return; } (*((real8 *) (*s_objet_resultat).objet)) = ((real8) 1) / diviseur_reel; } /* -------------------------------------------------------------------------------- Inversion donnant un résultat 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; } dividende_reel = 1; f77divisionrc_(÷nde_reel, &((*((struct_complexe16 *) (*s_objet_argument).objet))), &((*((struct_complexe16 *) (*s_objet_resultat).objet)))); } /* -------------------------------------------------------------------------------- Inversion donnant comme résultat une matrice réelle -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == MIN) || ((*s_objet_argument).type == MRL)) { if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes != (*((struct_matrice *) (*s_objet_argument).objet)) .nombre_colonnes) { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; return; } if ((s_objet_resultat = copie_objet(s_etat_processus, s_objet_argument, 'Q')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } inversion_matrice(s_etat_processus, (struct_matrice *) (*s_objet_resultat).objet); (*s_objet_resultat).type = MRL; if (((*s_etat_processus).exception != d_ep) || ((*s_etat_processus).erreur_execution != d_ex)) { liberation(s_etat_processus, s_objet_argument); liberation(s_etat_processus, s_objet_resultat); return; } if ((*s_etat_processus).erreur_systeme != d_es) { return; } } /* -------------------------------------------------------------------------------- Inversion donnant comme résultat une matrice complexe -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == MCX) { if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes != (*((struct_matrice *) (*s_objet_argument).objet)) .nombre_colonnes) { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides; return; } if ((s_objet_resultat = copie_objet(s_etat_processus, s_objet_argument, 'Q')) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } inversion_matrice(s_etat_processus, (struct_matrice *) (*s_objet_resultat).objet); if (((*s_etat_processus).exception != d_ep) || ((*s_etat_processus).erreur_execution != d_ex)) { liberation(s_etat_processus, s_objet_argument); liberation(s_etat_processus, s_objet_resultat); return; } if ((*s_etat_processus).erreur_systeme != d_es) { return; } } /* -------------------------------------------------------------------------------- Inversion 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_inv; 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, "INV"); 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; } /* -------------------------------------------------------------------------------- Inversion 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_inv; 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, "INV"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Inversion impossible -------------------------------------------------------------------------------- */ 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 'if' ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_if(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n IF "); if ((*s_etat_processus).langue == 'F') { printf("(structure de contrôle)\n\n"); printf(" Utilisation :\n\n"); } else { printf("(control statement)\n\n"); printf(" Usage:\n\n"); } printf(" IF\n"); printf(" (expression test 1)\n"); printf(" THEN\n"); printf(" (expression 1)\n"); printf(" [ELSEIF\n"); printf(" (expression test 2)\n"); printf(" THEN\n"); printf(" (expression 2)]\n"); printf(" ...\n"); printf(" [ELSE\n"); printf(" (expression n)]\n"); printf(" END\n"); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = -1; return; } empilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { return; } (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'I'; (*(*s_etat_processus).l_base_pile_systeme).clause = 'I'; return; } /* ================================================================================ Fonction 'iferr' ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_iferr(struct_processus *s_etat_processus) { (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n IFERR "); if ((*s_etat_processus).langue == 'F') { printf("(structure de contrôle)\n\n"); printf(" Utilisation :\n\n"); } else { printf("(control statement)\n\n"); printf(" Usage:\n\n"); } printf(" IFERR\n"); printf(" (expression test 1)\n"); printf(" THEN\n"); printf(" (expression 1)\n"); printf(" [ELSE\n"); printf(" (expression 2)]\n"); printf(" END\n"); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = -1; return; } empilement_pile_systeme(s_etat_processus); if ((*s_etat_processus).erreur_systeme != d_es) { return; } (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'J'; (*(*s_etat_processus).l_base_pile_systeme).clause = 'R'; (*(*s_etat_processus).l_base_pile_systeme).arret_si_exception = (*s_etat_processus).arret_si_exception; (*s_etat_processus).arret_si_exception = d_faux; return; } /* ================================================================================ Fonction 'ift' ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_ift(struct_processus *s_etat_processus) { struct_objet *s_objet_1; struct_objet *s_objet_2; logical1 condition; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n IFT "); if ((*s_etat_processus).langue == 'F') { printf("(structure IF/THEN/END simplifiée)\n\n"); } else { printf("(simplified IF/THEN/END structure)\n\n"); } printf(" 2: %s, %s\n", d_INT, d_REL); printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); 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_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_2) == d_erreur) { liberation(s_etat_processus, s_objet_1); (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if (((*s_objet_2).type == INT) || ((*s_objet_2).type == REL)) { if ((*s_objet_2).type == INT) { condition = ((*((integer8 *) (*s_objet_2).objet)) == 0) ? d_faux : d_vrai; } else { condition = ((*((real8 *) (*s_objet_2).objet)) == 0) ? d_faux : d_vrai; } if (condition == d_vrai) { if (evaluation(s_etat_processus, s_objet_1, (test_cfsf(s_etat_processus, 35) == d_vrai) ? 'E' : 'N') == d_erreur) { liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); return; } } else { liberation(s_etat_processus, s_objet_1); } liberation(s_etat_processus, s_objet_2); } else { liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } return; } /* ================================================================================ Fonction 'ifte' ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_ifte(struct_processus *s_etat_processus) { struct_objet *s_objet_1; struct_objet *s_objet_2; struct_objet *s_objet_3; logical1 condition; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n IFTE "); if ((*s_etat_processus).langue == 'F') { printf("(structure IF/THEN/ELSE/END simplifiée)\n\n"); } else { printf("(simplified IF/THEN/ELSE/END structure)\n\n"); } printf(" 3: %s, %s\n", d_INT, d_REL); printf(" 2: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s\n", d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = 3; return; } if (test_cfsf(s_etat_processus, 31) == d_vrai) { if (empilement_pile_last(s_etat_processus, 3) == d_erreur) { return; } } if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_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_2) == d_erreur) { liberation(s_etat_processus, s_objet_1); (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), &s_objet_3) == d_erreur) { liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if (((*s_objet_3).type == INT) || ((*s_objet_3).type == REL)) { if ((*s_objet_3).type == INT) { condition = ((*((integer8 *) (*s_objet_3).objet)) == 0) ? d_faux : d_vrai; } else { condition = ((*((real8 *) (*s_objet_3).objet)) == 0) ? d_faux : d_vrai; } if (condition == d_vrai) { if (evaluation(s_etat_processus, s_objet_2, (test_cfsf(s_etat_processus, 35) == d_vrai) ? 'E' : 'N') == d_erreur) { liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); liberation(s_etat_processus, s_objet_3); return; } liberation(s_etat_processus, s_objet_1); } else { if (evaluation(s_etat_processus, s_objet_1, (test_cfsf(s_etat_processus, 35) == d_vrai) ? 'E' : 'N') == d_erreur) { liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); liberation(s_etat_processus, s_objet_3); return; } liberation(s_etat_processus, s_objet_2); } liberation(s_etat_processus, s_objet_3); } else { liberation(s_etat_processus, s_objet_1); liberation(s_etat_processus, s_objet_2); liberation(s_etat_processus, s_objet_3); (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } return; } /* ================================================================================ Fonction 'i' ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_sensible_i(struct_processus *s_etat_processus) { (*s_etat_processus).instruction_sensible = 'Y'; if (strcmp((*s_etat_processus).instruction_courante, "i") == 0) { instruction_i(s_etat_processus); } else { (*s_etat_processus).instruction_valide = 'N'; } return; } void instruction_i(struct_processus *s_etat_processus) { struct_objet *s_objet; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n i "); if ((*s_etat_processus).langue == 'F') { printf("(entier de Gauss)\n\n"); } else { printf("(Gauss integer)\n\n"); } printf("-> 1: %s, %s\n", d_CPL, d_NOM); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).constante_symbolique = 'Y'; (*s_etat_processus).nombre_arguments = 3; return; } /* Indicateur 35 armé => évaluation symbolique */ if (test_cfsf(s_etat_processus, 35) == d_vrai) { if ((s_objet = allocation(s_etat_processus, NOM)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*((struct_nom *) (*s_objet).objet)).nom = malloc(2 * sizeof(unsigned char))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } strcpy((*((struct_nom *) (*s_objet).objet)).nom, "i"); (*((struct_nom *) (*s_objet).objet)).symbole = d_faux; } else { if ((s_objet = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_complexe16 *) (*s_objet).objet)).partie_reelle = 0; (*((struct_complexe16 *) (*s_objet).objet)).partie_imaginaire = 1; } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet) == d_erreur) { return; } return; } /* ================================================================================ Fonction 'ip' ================================================================================ Entrées : -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_ip(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 IP "); if ((*s_etat_processus).langue == 'F') { printf("(partie entière)\n\n"); } else { printf("(integer part)\n\n"); } printf(" 1: %s, %s\n", d_INT, d_REL); printf("-> 1: %s\n\n", d_INT); 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; } /* -------------------------------------------------------------------------------- ip d'un entier -------------------------------------------------------------------------------- */ if ((*s_objet_argument).type == INT) { s_objet_resultat = s_objet_argument; s_objet_argument = NULL; } /* -------------------------------------------------------------------------------- ip d'un réel -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == REL) { if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*((real8 *) (*s_objet_argument).objet)) > 0) { (*((integer8 *) (*s_objet_resultat).objet)) = (integer8) floor((*((real8 *) (*s_objet_argument).objet))); if (!((((*((integer8 *) (*s_objet_resultat).objet)) <= (*((real8 *) (*s_objet_argument).objet))) && (((*((integer8 *) (*s_objet_resultat).objet)) + 1) > (*((real8 *) (*s_objet_argument).objet)))))) { free((*s_objet_resultat).objet); if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*s_objet_resultat).type = REL; (*((real8 *) (*s_objet_resultat).objet)) = ceil((*((real8 *) (*s_objet_argument).objet))); } } else { (*((integer8 *) (*s_objet_resultat).objet)) = (integer8) ceil((*((real8 *) (*s_objet_argument).objet))); if (!(((((*((integer8 *) (*s_objet_resultat).objet)) - 1) < (*((real8 *) (*s_objet_argument).objet))) && ((*((integer8 *) (*s_objet_resultat).objet)) >= (*((real8 *) (*s_objet_argument).objet)))))) { free((*s_objet_resultat).objet); if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*s_objet_resultat).type = REL; (*((real8 *) (*s_objet_resultat).objet)) = ceil((*((real8 *) (*s_objet_argument).objet))); } } } /* -------------------------------------------------------------------------------- ip 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_ip; 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, "IP"); 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; } /* -------------------------------------------------------------------------------- ip 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_ip; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).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_precedent) .suivant).donnee).objet)).nom_fonction, "IP"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Fonction ip 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 'im' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_im(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; integer8 i; integer8 j; (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n IM "); if ((*s_etat_processus).langue == 'F') { printf("(partie imaginaire)\n\n"); } else { printf("(imaginary part)\n\n"); } printf(" 1: %s, %s\n", d_INT, d_REL); printf("-> 1: %s\n\n", d_INT); printf(" 1: %s\n", d_CPL); printf("-> 1: %s\n\n", d_REL); printf(" 1: %s, %s\n", d_VIN, d_VRL); printf("-> 1: %s\n\n", d_VIN); printf(" 1: %s\n", d_VCX); printf("-> 1: %s\n\n", d_VRL); printf(" 1: %s, %s\n", d_MIN, d_MRL); printf("-> 1: %s\n\n", d_MIN); printf(" 1: %s\n", d_MCX); printf("-> 1: %s\n\n", d_MRL); 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; } /* -------------------------------------------------------------------------------- Partie imaginaire 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, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((integer8 *) (*s_objet_resultat).objet)) = 0; } /* -------------------------------------------------------------------------------- Partie imaginaire 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)) = (*((struct_complexe16 *) (*s_objet_argument).objet)) .partie_imaginaire; } /* -------------------------------------------------------------------------------- Partie imaginaire d'un vecteur -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == VIN) || ((*s_objet_argument).type == VRL)) { if ((s_objet_resultat = allocation(s_etat_processus, VIN)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument) .objet))).taille) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = (*(((struct_vecteur *) (*s_objet_argument).objet))).taille; for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet))) .taille; i++) { ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat).objet)) .tableau)[i] = 0; } } else if ((*s_objet_argument).type == VCX) { if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument) .objet))).taille) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = (*(((struct_vecteur *) (*s_objet_argument).objet))).taille; for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet))) .taille; i++) { ((real8 *) (*((struct_vecteur *) (*s_objet_resultat).objet)) .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *) (*s_objet_argument).objet)).tableau)[i].partie_imaginaire; } } /* -------------------------------------------------------------------------------- Partie imaginaire d'une matrice -------------------------------------------------------------------------------- */ else if (((*s_objet_argument).type == MIN) || ((*s_objet_argument).type == MRL)) { if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument) .objet))).nombre_lignes) * sizeof(integer8 *))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = (*((struct_matrice *) (*s_objet_argument).objet)) .nombre_colonnes; for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_lignes; i++) { if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_colonnes) * sizeof(integer8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_colonnes; j++) { ((integer8 **) (*((struct_matrice *) (*s_objet_resultat).objet)).tableau)[i][j] = 0; } } } else if ((*s_objet_argument).type == MCX) { if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau = malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument) .objet))).nombre_lignes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes; (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes = (*((struct_matrice *) (*s_objet_argument).objet)) .nombre_colonnes; for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_lignes; i++) { if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat) .objet)).tableau)[i] = malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_colonnes) * sizeof(real8))) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet))) .nombre_colonnes; j++) { ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet)) .tableau)[i][j] = ((struct_complexe16 **) (*((struct_matrice *) (*s_objet_argument).objet)) .tableau)[i][j].partie_imaginaire; } } } /* -------------------------------------------------------------------------------- Partie imaginaire 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_im; 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, "IM"); 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; } /* -------------------------------------------------------------------------------- Partie imaginaire 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_im; if (((*((struct_fonction *) (*(*(*l_element_precedent) .suivant).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_precedent) .suivant).donnee).objet)).nom_fonction, "IM"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Réalisation impossible de la fonction partie imaginaire -------------------------------------------------------------------------------- */ 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