/* ================================================================================ 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 'type' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_type(struct_processus *s_etat_processus) { 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 TYPE "); if ((*s_etat_processus).langue == 'F') { printf("(type d'objet)\n\n"); } else { printf("(object type)\n\n"); } printf(" 1: %s, %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s, %s,\n" " %s, %s, %s, %s,\n" " %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, d_SCK, d_PRC, d_TAB, d_SQL, d_MTX, d_SPH, d_REC); printf("-> 1: %s\n\n", d_INT); if ((*s_etat_processus).langue == 'F') { printf(" Valeurs renvoyées : \n\n"); printf(" 0 : scalaire (entier ou réel)\n"); printf(" 1 : complexe\n"); printf(" 2 : chaîne de caractères\n"); printf(" 3 : vecteur ou matrice de scalaires\n"); printf(" 4 : vecteur ou matrice de complexes\n"); printf(" 5 : liste\n"); printf(" 6 : adresse\n"); printf(" 7 : nom\n"); printf(" 8 : expression en notation polonaire inversée\n"); printf(" 9 : expression algébrique\n"); printf(" 10 : entier binaire\n"); printf(" 11 : descripteur de fichier\n"); printf(" 12 : descripteur de bibliothèque partagée\n"); printf(" 13 : descripteur de socket\n"); printf(" 14 : processus\n"); printf(" 15 : fonction\n"); printf(" 16 : table\n"); printf(" 17 : connecteur SQL\n"); printf(" 18 : mutex\n"); printf(" 19 : sémaphore\n"); printf(" 20 : enregistrement\n"); } else { printf(" Returned values : \n\n"); printf(" 0 : scalar, integer or real number\n"); printf(" 1 : complex\n"); printf(" 2 : string\n"); printf(" 3 : scalar vector or scalar matrix\n"); printf(" 4 : complex vector or complex matrix\n"); printf(" 5 : list\n"); printf(" 6 : address\n"); printf(" 7 : name\n"); printf(" 8 : RPN expression\n"); printf(" 9 : algebraic expression\n"); printf(" 10 : binary integer\n"); printf(" 11 : file descriptor\n"); printf(" 12 : shared library descriptor\n"); printf(" 13 : socket descriptor\n"); printf(" 14 : process\n"); printf(" 15 : function\n"); printf(" 16 : table\n"); printf(" 17 : SQL connector\n"); printf(" 18 : mutex\n"); printf(" 19 : semaphore\n"); printf(" 20 : record\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, 1) == d_erreur) { return; } } if (depilement(s_etat_processus, &((*s_etat_processus) .l_base_pile), &s_objet_argument) == d_erreur) { (*s_etat_processus).erreur_execution = d_ex_manque_argument; return; } if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (((*s_objet_argument).type == INT) || ((*s_objet_argument).type == REL)) { (*((integer8 *) (*s_objet_resultat).objet)) = 0; } else if ((*s_objet_argument).type == CPL) { (*((integer8 *) (*s_objet_resultat).objet)) = 1; } else if ((*s_objet_argument).type == CHN) { (*((integer8 *) (*s_objet_resultat).objet)) = 2; } else if (((*s_objet_argument).type == VIN) || ((*s_objet_argument).type == VRL) || ((*s_objet_argument).type == MIN) || ((*s_objet_argument).type == MRL)) { (*((integer8 *) (*s_objet_resultat).objet)) = 3; } else if (((*s_objet_argument).type == VCX) || ((*s_objet_argument).type == MCX)) { (*((integer8 *) (*s_objet_resultat).objet)) = 4; } else if ((*s_objet_argument).type == LST) { (*((integer8 *) (*s_objet_resultat).objet)) = 5; } else if ((*s_objet_argument).type == ADR) { (*((integer8 *) (*s_objet_resultat).objet)) = 6; } else if ((*s_objet_argument).type == NOM) { (*((integer8 *) (*s_objet_resultat).objet)) = 7; } else if ((*s_objet_argument).type == RPN) { (*((integer8 *) (*s_objet_resultat).objet)) = 8; } else if ((*s_objet_argument).type == ALG) { (*((integer8 *) (*s_objet_resultat).objet)) = 9; } else if ((*s_objet_argument).type == BIN) { (*((integer8 *) (*s_objet_resultat).objet)) = 10; } else if ((*s_objet_argument).type == FCH) { (*((integer8 *) (*s_objet_resultat).objet)) = 11; } else if ((*s_objet_argument).type == SLB) { (*((integer8 *) (*s_objet_resultat).objet)) = 12; } else if ((*s_objet_argument).type == SCK) { (*((integer8 *) (*s_objet_resultat).objet)) = 13; } else if ((*s_objet_argument).type == PRC) { (*((integer8 *) (*s_objet_resultat).objet)) = 14; } else if ((*s_objet_argument).type == FCT) { (*((integer8 *) (*s_objet_resultat).objet)) = 15; } else if ((*s_objet_argument).type == TBL) { (*((integer8 *) (*s_objet_resultat).objet)) = 16; } else if ((*s_objet_argument).type == SQL) { (*((integer8 *) (*s_objet_resultat).objet)) = 17; } else if ((*s_objet_argument).type == MTX) { (*((integer8 *) (*s_objet_resultat).objet)) = 18; } else if ((*s_objet_argument).type == SPH) { (*((integer8 *) (*s_objet_resultat).objet)) = 19; } else if ((*s_objet_argument).type == REC) { (*((integer8 *) (*s_objet_resultat).objet)) = 20; } else if ((*s_objet_argument).type == EXT) { (*((integer8 *) (*s_objet_resultat).objet)) = 21; } else { /* * Les autres types de données sont des types internes */ 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) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } liberation(s_etat_processus, s_objet_argument); return; } /* ================================================================================ Fonction 'then' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_then(struct_processus *s_etat_processus) { logical1 condition; logical1 drapeau_fin; logical1 execution; struct_liste_chainee *s_registre; struct_liste_pile_systeme *l_element_courant; struct_objet *s_objet; unsigned char *instruction_majuscule; unsigned char *tampon; integer8 niveau; void (*fonction)(); (*s_etat_processus).erreur_execution = d_ex; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n THEN "); 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(ERR)\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\n"); printf(" SELECT (expression test)\n"); printf(" CASE (clause 1) THEN (expression 1) END\n"); printf(" CASE (clause 2) THEN (expression 2) END\n"); printf(" ...\n"); printf(" CASE (clause n) THEN (expression n) END\n"); printf(" DEFAULT\n"); printf(" (expression)\n"); printf(" END\n\n"); printf(" SELECT (expression test)\n"); printf(" CASE (clause 1) THEN (expression 1) END\n"); printf(" (expression)\n"); printf(" CASE (clause 2) THEN (expression 2) END\n"); printf(" END\n"); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = -1; return; } if (((*(*s_etat_processus).l_base_pile_systeme).clause != 'I') && ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T') && ((*(*s_etat_processus).l_base_pile_systeme).clause != 'R') && ((*(*s_etat_processus).l_base_pile_systeme).clause != 'X') && ((*(*s_etat_processus).l_base_pile_systeme).clause != 'C') && ((*(*s_etat_processus).l_base_pile_systeme).clause != 'K')) { (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition; return; } /* * Traitement des erreurs */ if (((*(*s_etat_processus).l_base_pile_systeme).clause == 'R') || ((*(*s_etat_processus).l_base_pile_systeme).clause == 'X')) { if ((s_objet = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'R') { /* * Erreur à traiter : on saute jusques au ELSE ou au END * correspondant. */ (*((integer8 *) (*s_objet).objet)) = 0; } else { (*((integer8 *) (*s_objet).objet)) = -1; } if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet) == d_erreur) { return; } (*s_etat_processus).arret_si_exception = (*(*s_etat_processus) .l_base_pile_systeme).arret_si_exception; } /* * Traitement standard de l'instruction 'THEN' */ 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) == d_erreur) { return; } if (((*s_objet).type == INT) || ((*s_objet).type == REL)) { if ((*s_objet).type == INT) { condition = ((*((integer8 *) (*s_objet).objet)) == 0) ? d_faux : d_vrai; } else { condition = ((*((real8 *) (*s_objet).objet)) == 0) ? d_faux : d_vrai; } if (condition == d_vrai) { /* * condition == d_vrai : exécution de ce qui se trouve entre * THEN et ELSE ou END. */ if (((*(*s_etat_processus).l_base_pile_systeme).clause == 'I') || ((*(*s_etat_processus).l_base_pile_systeme).clause == 'X')) { (*(*s_etat_processus).l_base_pile_systeme).clause = 'T'; } else { if ((*s_etat_processus).l_base_pile_systeme == NULL) { (*s_etat_processus).erreur_systeme = d_es_pile_vide; return; } l_element_courant = (*(*s_etat_processus).l_base_pile_systeme) .suivant; while(l_element_courant != NULL) { if ((*l_element_courant).clause == 'K') { (*l_element_courant).clause = 'Q'; break; } l_element_courant = (*l_element_courant).suivant; } } } else { /* * condition == d_faux : saut à END ou exécution de ce qui se * trouve entre ELSE et END */ if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T') { /* * Traitement de ELSEIF */ if (((*(*s_etat_processus).l_base_pile_systeme).clause != 'K') && ((*(*s_etat_processus).l_base_pile_systeme) .clause != 'C')) { (*(*s_etat_processus).l_base_pile_systeme).clause = 'E'; } } niveau = 0; drapeau_fin = d_faux; if ((*s_etat_processus).mode_execution_programme == 'Y') { tampon = (*s_etat_processus).instruction_courante; do { if (recherche_instruction_suivante(s_etat_processus) == d_erreur) { liberation(s_etat_processus, s_objet); if ((*s_etat_processus).instruction_courante != NULL) { free((*s_etat_processus).instruction_courante); } (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition; return; } if ((instruction_majuscule = conversion_majuscule( s_etat_processus, (*s_etat_processus).instruction_courante)) == NULL) { liberation(s_etat_processus, s_objet); free((*s_etat_processus).instruction_courante); (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } if (niveau == 0) { if (((*(*s_etat_processus).l_base_pile_systeme) .clause != 'K') && ((*(*s_etat_processus) .l_base_pile_systeme) .clause != 'C')) { /* * Traitement de IF/THEN/ELSEIF/THEN/ELSE/END */ if ((strcmp(instruction_majuscule, "END") == 0) || (strcmp(instruction_majuscule, "ELSE") == 0) || (strcmp(instruction_majuscule, "ELSEIF") == 0)) { (*s_etat_processus).position_courante -= (integer8) (strlen( instruction_majuscule) + 1); drapeau_fin = d_vrai; } else { drapeau_fin = d_faux; } } else { /* * Traitement de CASE/THEN/END */ if (strcmp(instruction_majuscule, "ELSE") == 0) { liberation(s_etat_processus, s_objet); free((*s_etat_processus).instruction_courante); free(instruction_majuscule); (*s_etat_processus).instruction_courante = tampon; (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition; return; } else if (strcmp(instruction_majuscule, "END") == 0) { instruction_end(s_etat_processus); drapeau_fin = d_vrai; } else { drapeau_fin = d_faux; } } } else { drapeau_fin = d_faux; } if ((strcmp(instruction_majuscule, "CASE") == 0) || (strcmp(instruction_majuscule, "DO") == 0) || (strcmp(instruction_majuscule, "IF") == 0) || (strcmp(instruction_majuscule, "IFERR") == 0) || (strcmp(instruction_majuscule, "SELECT") == 0) || (strcmp(instruction_majuscule, "WHILE") == 0)) { niveau++; } else if (strcmp(instruction_majuscule, "END") == 0) { niveau--; } free(instruction_majuscule); free((*s_etat_processus).instruction_courante); } while(drapeau_fin == d_faux); (*s_etat_processus).instruction_courante = tampon; } else { /* * Vérification du pointeur de prédiction de saut. */ if (pthread_mutex_lock(&((*(*(*s_etat_processus) .expression_courante).donnee).mutex)) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } if ((*((struct_fonction *) (*(*(*s_etat_processus) .expression_courante).donnee).objet)).prediction_saut != NULL) { s_registre = (*s_etat_processus).expression_courante; (*s_etat_processus).expression_courante = (struct_liste_chainee *) (*((struct_fonction *) (*(*(*s_etat_processus) .expression_courante).donnee).objet)) .prediction_saut; fonction = (*((struct_fonction *) (*(*(*s_etat_processus).expression_courante) .donnee).objet)).fonction; execution = (*((struct_fonction *) (*(*s_registre).donnee).objet)) .prediction_execution; if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex)) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } if (execution == d_vrai) { fonction(s_etat_processus); } } else { if (pthread_mutex_unlock(&((*(*(*s_etat_processus) .expression_courante).donnee).mutex)) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } s_registre = (*s_etat_processus).expression_courante; execution = d_faux; do { if (((*s_etat_processus).expression_courante = (*(*s_etat_processus).expression_courante) .suivant) == NULL) { liberation(s_etat_processus, s_objet); (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition; return; } if ((*(*(*s_etat_processus).expression_courante) .donnee).type == FCT) { fonction = (*((struct_fonction *) (*(*(*s_etat_processus).expression_courante) .donnee).objet)).fonction; if (niveau == 0) { if (((*(*s_etat_processus).l_base_pile_systeme) .clause != 'K') && ((*(*s_etat_processus) .l_base_pile_systeme).clause != 'C')) { /* * Traitement de IF/THEN/ELSEIF/THEN/ * ELSE/END */ if ((fonction == instruction_end) || (fonction == instruction_else) || (fonction == instruction_elseif)) { fonction(s_etat_processus); execution = d_vrai; drapeau_fin = d_vrai; } else { drapeau_fin = d_faux; } } else { /* * Traitement de CASE/THEN/END */ if (fonction == instruction_else) { liberation(s_etat_processus, s_objet); if ((drapeau_fin == d_faux) && ((*s_etat_processus) .expression_courante != NULL)) { (*s_etat_processus) .expression_courante = (*(*s_etat_processus) .expression_courante) .suivant; } (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition; return; } else if (fonction == instruction_end) { fonction(s_etat_processus); execution = d_vrai; drapeau_fin = d_vrai; } else { drapeau_fin = d_faux; } } } else { drapeau_fin = d_faux; } if ((fonction == instruction_case) || (fonction == instruction_do) || (fonction == instruction_if) || (fonction == instruction_iferr) || (fonction == instruction_select) || (fonction == instruction_while)) { niveau++; } else if (fonction == instruction_end) { niveau--; } } } while(drapeau_fin == d_faux); if (pthread_mutex_lock(&((*(*(*s_etat_processus) .expression_courante).donnee).mutex)) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } (*((struct_fonction *) (*(*s_registre).donnee).objet)) .prediction_saut = (*s_etat_processus) .expression_courante; (*((struct_fonction *) (*(*s_registre).donnee).objet)) .prediction_execution = execution; if (pthread_mutex_unlock(&((*(*(*s_etat_processus) .expression_courante).donnee).mutex)) != 0) { (*s_etat_processus).erreur_systeme = d_es_processus; return; } } } } } else { (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; return; } liberation(s_etat_processus, s_objet); return; } /* ================================================================================ Fonction 'tan' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_tan(struct_processus *s_etat_processus) { real8 angle; 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 TAN "); if ((*s_etat_processus).langue == 'F') { printf("(tangente)\n\n"); } else { printf("(tangent)\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_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; } /* -------------------------------------------------------------------------------- Tangente 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) { angle = (real8) (*((integer8 *) (*s_objet_argument).objet)); } else { angle = (*((real8 *) (*s_objet_argument).objet)); } if (test_cfsf(s_etat_processus, 60) == d_faux) { conversion_degres_vers_radians(&angle); } if ((cos(angle) == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai)) { liberation(s_etat_processus, s_objet_argument); liberation(s_etat_processus, s_objet_resultat); (*s_etat_processus).exception = d_ep_division_par_zero; return; } (*((real8 *) (*s_objet_resultat).objet)) = tan(angle); } /* -------------------------------------------------------------------------------- Tangente 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; } f77tan_((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); (*s_etat_processus).exception = d_ep_division_par_zero; return; } } /* -------------------------------------------------------------------------------- Tangente 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_tan; 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, "TAN"); 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; } /* -------------------------------------------------------------------------------- Tangente 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_tan; 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, "TAN"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Réalisation impossible de la fonction tangente -------------------------------------------------------------------------------- */ 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 'tanh' ================================================================================ Entrées : pointeur sur une structure struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_tanh(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 TANH "); if ((*s_etat_processus).langue == 'F') { printf("(tangente hyperbolique)\n\n"); } else { printf("(hyperbolic tangent)\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_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; } /* -------------------------------------------------------------------------------- Tangente hyperbolique 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) { argument = (real8) (*((integer8 *) (*s_objet_argument).objet)); } else { argument = (*((real8 *) (*s_objet_argument).objet)); } (*((real8 *) (*s_objet_resultat).objet)) = tanh(argument); } /* -------------------------------------------------------------------------------- Tangente hyperbolique 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; } f77tanh_((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); (*s_etat_processus).exception = d_ep_division_par_zero; return; } } /* -------------------------------------------------------------------------------- Tangente hyperbolique 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_tanh; 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, "TANH"); 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; } /* -------------------------------------------------------------------------------- Tangente hyperbolique 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_tanh; 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, "TANH"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Réalisation impossible de la fonction tangente hyperbolique -------------------------------------------------------------------------------- */ 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 'true' ================================================================================ Entrées : structure processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_true(struct_processus *s_etat_processus) { struct_objet *s_objet; if ((*s_etat_processus).affichage_arguments == 'Y') { printf("\n TRUE "); if ((*s_etat_processus).langue == 'F') { printf("(valeur vraie)\n\n"); } else { printf("(true value)\n\n"); } printf("-> 1: %s\n", d_INT); return; } else if ((*s_etat_processus).test_instruction == 'Y') { (*s_etat_processus).nombre_arguments = -1; return; } if ((s_objet = allocation(s_etat_processus, INT)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } (*((integer8 *) (*s_objet).objet)) = -1; if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), s_objet) == d_erreur) { return; } return; } // vim: ts=4