/* ================================================================================ RPL/2 (R) version 4.0.17 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 'log' (logarithme vulgaire) ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_log(struct_processus *s_etat_processus) { 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 LOG "); if ((*s_etat_processus).langue == 'F') { printf("(logarithme à base 10)\n\n"); } else { printf("(10-based logarithm)\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; } /* -------------------------------------------------------------------------------- Logarithme décimal d'un entier -------------------------------------------------------------------------------- */ if ((*s_objet_argument).type == INT) { if ((*((integer8 *) (*s_objet_argument).objet)) >= 0) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77logip_((integer8 *) (*s_objet_argument).objet, (real8 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { (*((real8 *) (*s_objet_resultat).objet)) = ((double) 1) / ((double) 0); } } } else { if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77login_((integer8 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { 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)) = ((double) 1) / ((double) 0); } } } } /* -------------------------------------------------------------------------------- Logarithme décimal d'un réel -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == REL) { if ((*((real8 *) (*s_objet_argument).objet)) >= 0) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77logrp_((real8 *) (*s_objet_argument).objet, (real8 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { (*((real8 *) (*s_objet_resultat).objet)) = ((double) 1) / ((double) 0); } } } else { if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77logrn_((real8 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { 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)) = ((double) 1) / ((double) 0); } } } } /* -------------------------------------------------------------------------------- Logarithme décimal 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; } f77logc_((struct_complexe16 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { 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)) = ((double) 1) / ((double) 0); } } } /* -------------------------------------------------------------------------------- Logarithme décimal 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_log; 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, "LOG"); 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; } /* -------------------------------------------------------------------------------- Logarithme décimal 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_log; 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, "LOG"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Fonction logarithme décimal impossible à réaliser -------------------------------------------------------------------------------- */ 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 'ln' (logarithme népérien) ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_ln(struct_processus *s_etat_processus) { 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 LN "); if ((*s_etat_processus).langue == 'F') { printf("(logarithme népérien)\n\n"); } else { printf("(natural logarithm)\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; } /* -------------------------------------------------------------------------------- Logarithme naturel d'un entier -------------------------------------------------------------------------------- */ if ((*s_objet_argument).type == INT) { if ((*((integer8 *) (*s_objet_argument).objet)) >= 0) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77lnip_((integer8 *) (*s_objet_argument).objet, (real8 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { (*((real8 *) (*s_objet_resultat).objet)) = ((double) 1) / ((double) 0); } } } else { if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77lnin_((integer8 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { 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)) = ((double) 1) / ((double) 0); } } } } /* -------------------------------------------------------------------------------- Logarithme naturel d'un réel -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == REL) { if ((*((real8 *) (*s_objet_argument).objet)) >= 0) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77lnrp_((real8 *) (*s_objet_argument).objet, (real8 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { (*((real8 *) (*s_objet_resultat).objet)) = ((double) 1) / ((double) 0); } } } else { if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } f77lnrn_((real8 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { 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)) = ((double) 1) / ((double) 0); } } } } /* -------------------------------------------------------------------------------- Logarithme naturel 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; } f77lnc_((struct_complexe16 *) (*s_objet_argument).objet, (struct_complexe16 *) (*s_objet_resultat).objet, &erreur); if (erreur != 0) { if (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_overflow; return; } else { 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)) = ((double) 1) / ((double) 0); } } } /* -------------------------------------------------------------------------------- Logarithme naturel 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_ln; 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, "LN"); 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; } /* -------------------------------------------------------------------------------- Logarithme naturel 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_ln; 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, "LN"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Fonction logarithme naturel impossible à réaliser -------------------------------------------------------------------------------- */ 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 'lnp1' (logarithme népérien) ================================================================================ Entrées : pointeur sur une struct_processus -------------------------------------------------------------------------------- Sorties : -------------------------------------------------------------------------------- Effets de bord : néant ================================================================================ */ void instruction_lnp1(struct_processus *s_etat_processus) { int 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 LNP1 "); if ((*s_etat_processus).langue == 'F') { printf("(logarithme népérien plus un)\n\n"); } else { printf("(ln + 1)\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; } /* -------------------------------------------------------------------------------- Logarithme naturel (+1) d'un entier -------------------------------------------------------------------------------- */ if ((*s_objet_argument).type == INT) { if ((*((integer8 *) (*s_objet_argument).objet)) > -1) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } erreur = (finite((*((real8 *) (*s_objet_resultat).objet)) = log1p((real8) (*((integer8 *) (*s_objet_argument).objet)))) == 0); if (erreur != 0) { if (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_overflow; return; } else { (*((real8 *) (*s_objet_resultat).objet)) = ((double) 1) / ((double) 0); } } } else { if (test_cfsf(s_etat_processus, 59) == d_vrai) { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).exception = d_ep_overflow; return; } else { 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)) = ((double) 0) / ((double) 0); } } } /* -------------------------------------------------------------------------------- Logarithme naturel (+1) d'un réel -------------------------------------------------------------------------------- */ else if ((*s_objet_argument).type == REL) { if ((*((real8 *) (*s_objet_argument).objet)) > -1) { if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL) { (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; return; } erreur = (finite((*((real8 *) (*s_objet_resultat).objet)) = log1p((*((real8 *) (*s_objet_argument).objet)))) == 0); if (erreur != 0) { if (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_overflow; return; } else { (*((real8 *) (*s_objet_resultat).objet)) = ((double) 1) / ((double) 0); } } } else { if (test_cfsf(s_etat_processus, 59) == d_vrai) { liberation(s_etat_processus, s_objet_argument); (*s_etat_processus).exception = d_ep_overflow; return; } else { 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)) = ((double) 0) / ((double) 0); } } } /* -------------------------------------------------------------------------------- Logarithme naturel (+1) 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_lnp1; 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, "LNP1"); 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; } /* -------------------------------------------------------------------------------- Logarithme naturel (+1) 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_lnp1; 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, "LNP1"); (*(*l_element_precedent).suivant).suivant = l_element_courant; s_objet_resultat = s_copie_argument; } /* -------------------------------------------------------------------------------- Fonction logarithme naturel (+1) impossible à réaliser -------------------------------------------------------------------------------- */ 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