Annotation of rpl/src/instructions_a2.c, revision 1.1
1.1 ! bertrand 1: /*
! 2: ================================================================================
! 3: RPL/2 (R) version 4.0.9
! 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
! 5:
! 6: This file is part of RPL/2.
! 7:
! 8: RPL/2 is free software; you can redistribute it and/or modify it
! 9: under the terms of the CeCILL V2 License as published by the french
! 10: CEA, CNRS and INRIA.
! 11:
! 12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
! 13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
! 14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
! 15: for more details.
! 16:
! 17: You should have received a copy of the CeCILL License
! 18: along with RPL/2. If not, write to info@cecill.info.
! 19: ================================================================================
! 20: */
! 21:
! 22:
! 23: #include "rpl.conv.h"
! 24:
! 25:
! 26: /*
! 27: ================================================================================
! 28: Fonction 'asinh'
! 29: ================================================================================
! 30: Entrées : pointeur sur une structure struct_processus
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_asinh(struct_processus *s_etat_processus)
! 40: {
! 41: struct_liste_chainee *l_element_courant;
! 42: struct_liste_chainee *l_element_precedent;
! 43:
! 44: struct_objet *s_copie_argument;
! 45: struct_objet *s_objet_argument;
! 46: struct_objet *s_objet_resultat;
! 47:
! 48: (*s_etat_processus).erreur_execution = d_ex;
! 49:
! 50: if ((*s_etat_processus).affichage_arguments == 'Y')
! 51: {
! 52: printf("\n ASINH ");
! 53:
! 54: if ((*s_etat_processus).langue == 'F')
! 55: {
! 56: printf("(argument du sinus hyperbolique)\n\n");
! 57: }
! 58: else
! 59: {
! 60: printf("(hyperbolic sine argument)\n\n");
! 61: }
! 62:
! 63: printf(" 1: %s, %s\n", d_INT, d_REL);
! 64: printf("-> 1: %s\n\n", d_REL);
! 65:
! 66: printf(" 1: %s\n", d_CPL);
! 67: printf("-> 1: %s\n\n", d_CPL);
! 68:
! 69: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 70: printf("-> 1: %s\n\n", d_ALG);
! 71:
! 72: printf(" 1: %s\n", d_RPN);
! 73: printf("-> 1: %s\n", d_RPN);
! 74:
! 75: return;
! 76: }
! 77: else if ((*s_etat_processus).test_instruction == 'Y')
! 78: {
! 79: (*s_etat_processus).nombre_arguments = 1;
! 80: return;
! 81: }
! 82:
! 83: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 84: {
! 85: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 86: {
! 87: return;
! 88: }
! 89: }
! 90:
! 91: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 92: &s_objet_argument) == d_erreur)
! 93: {
! 94: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 95: return;
! 96: }
! 97:
! 98: /*
! 99: --------------------------------------------------------------------------------
! 100: Argsh d'un entier ou d'un réel
! 101: --------------------------------------------------------------------------------
! 102: */
! 103:
! 104: if (((*s_objet_argument).type == INT) ||
! 105: ((*s_objet_argument).type == REL))
! 106: {
! 107: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 108: == NULL)
! 109: {
! 110: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 111: return;
! 112: }
! 113:
! 114: if ((*s_objet_argument).type == INT)
! 115: {
! 116: f77asinhi_((integer8 *) (*s_objet_argument).objet,
! 117: (real8 *) (*s_objet_resultat).objet);
! 118: }
! 119: else
! 120: {
! 121: f77asinhr_((real8 *) (*s_objet_argument).objet,
! 122: (real8 *) (*s_objet_resultat).objet);
! 123: }
! 124: }
! 125:
! 126: /*
! 127: --------------------------------------------------------------------------------
! 128: Argsh d'un complexe
! 129: --------------------------------------------------------------------------------
! 130: */
! 131:
! 132: else if ((*s_objet_argument).type == CPL)
! 133: {
! 134: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 135: == NULL)
! 136: {
! 137: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 138: return;
! 139: }
! 140:
! 141: f77asinhc_((struct_complexe16 *) (*s_objet_argument).objet,
! 142: (struct_complexe16 *) (*s_objet_resultat).objet);
! 143: }
! 144:
! 145: /*
! 146: --------------------------------------------------------------------------------
! 147: Argsh d'un nom
! 148: --------------------------------------------------------------------------------
! 149: */
! 150:
! 151: else if ((*s_objet_argument).type == NOM)
! 152: {
! 153: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 154: == NULL)
! 155: {
! 156: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 157: return;
! 158: }
! 159:
! 160: if (((*s_objet_resultat).objet =
! 161: allocation_maillon(s_etat_processus)) == NULL)
! 162: {
! 163: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 164: return;
! 165: }
! 166:
! 167: l_element_courant = (*s_objet_resultat).objet;
! 168:
! 169: if (((*l_element_courant).donnee =
! 170: allocation(s_etat_processus, FCT)) == NULL)
! 171: {
! 172: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 173: return;
! 174: }
! 175:
! 176: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 177: .nombre_arguments = 0;
! 178: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 179: .fonction = instruction_vers_niveau_superieur;
! 180:
! 181: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 182: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 183: {
! 184: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 185: return;
! 186: }
! 187:
! 188: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 189: .nom_fonction, "<<");
! 190:
! 191: if (((*l_element_courant).suivant =
! 192: allocation_maillon(s_etat_processus)) == NULL)
! 193: {
! 194: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 195: return;
! 196: }
! 197:
! 198: l_element_courant = (*l_element_courant).suivant;
! 199: (*l_element_courant).donnee = s_objet_argument;
! 200:
! 201: if (((*l_element_courant).suivant =
! 202: allocation_maillon(s_etat_processus)) == NULL)
! 203: {
! 204: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 205: return;
! 206: }
! 207:
! 208: l_element_courant = (*l_element_courant).suivant;
! 209:
! 210: if (((*l_element_courant).donnee =
! 211: allocation(s_etat_processus, FCT)) == NULL)
! 212: {
! 213: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 214: return;
! 215: }
! 216:
! 217: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 218: .nombre_arguments = 1;
! 219: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 220: .fonction = instruction_asinh;
! 221:
! 222: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 223: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
! 224: {
! 225: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 226: return;
! 227: }
! 228:
! 229: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 230: .nom_fonction, "ASINH");
! 231:
! 232: if (((*l_element_courant).suivant =
! 233: allocation_maillon(s_etat_processus)) == NULL)
! 234: {
! 235: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 236: return;
! 237: }
! 238:
! 239: l_element_courant = (*l_element_courant).suivant;
! 240:
! 241: if (((*l_element_courant).donnee =
! 242: allocation(s_etat_processus, FCT)) == NULL)
! 243: {
! 244: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 245: return;
! 246: }
! 247:
! 248: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 249: .nombre_arguments = 0;
! 250: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 251: .fonction = instruction_vers_niveau_inferieur;
! 252:
! 253: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 254: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 255: {
! 256: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 257: return;
! 258: }
! 259:
! 260: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 261: .nom_fonction, ">>");
! 262:
! 263: (*l_element_courant).suivant = NULL;
! 264: s_objet_argument = NULL;
! 265: }
! 266:
! 267: /*
! 268: --------------------------------------------------------------------------------
! 269: Argsh d'une expression
! 270: --------------------------------------------------------------------------------
! 271: */
! 272:
! 273: else if (((*s_objet_argument).type == ALG) ||
! 274: ((*s_objet_argument).type == RPN))
! 275: {
! 276: if ((s_copie_argument = copie_objet(s_etat_processus,
! 277: s_objet_argument, 'N')) == NULL)
! 278: {
! 279: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 280: return;
! 281: }
! 282:
! 283: l_element_courant = (struct_liste_chainee *)
! 284: (*s_copie_argument).objet;
! 285: l_element_precedent = l_element_courant;
! 286:
! 287: while((*l_element_courant).suivant != NULL)
! 288: {
! 289: l_element_precedent = l_element_courant;
! 290: l_element_courant = (*l_element_courant).suivant;
! 291: }
! 292:
! 293: if (((*l_element_precedent).suivant =
! 294: allocation_maillon(s_etat_processus)) == NULL)
! 295: {
! 296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 297: return;
! 298: }
! 299:
! 300: if (((*(*l_element_precedent).suivant).donnee =
! 301: allocation(s_etat_processus, FCT)) == NULL)
! 302: {
! 303: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 304: return;
! 305: }
! 306:
! 307: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 308: .donnee).objet)).nombre_arguments = 1;
! 309: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 310: .donnee).objet)).fonction = instruction_asinh;
! 311:
! 312: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 313: .suivant).donnee).objet)).nom_fonction =
! 314: malloc(6 * sizeof(unsigned char))) == NULL)
! 315: {
! 316: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 317: return;
! 318: }
! 319:
! 320: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 321: .suivant).donnee).objet)).nom_fonction, "ASINH");
! 322:
! 323: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 324:
! 325: s_objet_resultat = s_copie_argument;
! 326: }
! 327:
! 328: /*
! 329: --------------------------------------------------------------------------------
! 330: Réalisation impossible de la fonction argsh
! 331: --------------------------------------------------------------------------------
! 332: */
! 333:
! 334: else
! 335: {
! 336: liberation(s_etat_processus, s_objet_argument);
! 337:
! 338: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 339: return;
! 340: }
! 341:
! 342: liberation(s_etat_processus, s_objet_argument);
! 343:
! 344: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 345: s_objet_resultat) == d_erreur)
! 346: {
! 347: return;
! 348: }
! 349:
! 350: return;
! 351: }
! 352:
! 353:
! 354: /*
! 355: ================================================================================
! 356: Fonction 'acosh'
! 357: ================================================================================
! 358: Entrées : pointeur sur une structure struct_processus
! 359: --------------------------------------------------------------------------------
! 360: Sorties :
! 361: --------------------------------------------------------------------------------
! 362: Effets de bord : néant
! 363: ================================================================================
! 364: */
! 365:
! 366: void
! 367: instruction_acosh(struct_processus *s_etat_processus)
! 368: {
! 369: real8 argument;
! 370:
! 371: struct_complexe16 registre;
! 372:
! 373: struct_liste_chainee *l_element_courant;
! 374: struct_liste_chainee *l_element_precedent;
! 375:
! 376: struct_objet *s_copie_argument;
! 377: struct_objet *s_objet_argument;
! 378: struct_objet *s_objet_resultat;
! 379:
! 380: (*s_etat_processus).erreur_execution = d_ex;
! 381:
! 382: if ((*s_etat_processus).affichage_arguments == 'Y')
! 383: {
! 384: printf("\n ACOSH ");
! 385:
! 386: if ((*s_etat_processus).langue == 'F')
! 387: {
! 388: printf("(argument du cosinus hyperbolique)\n\n");
! 389: }
! 390: else
! 391: {
! 392: printf("(hyperbolic cosine argument)\n\n");
! 393: }
! 394:
! 395: printf(" 1: %s, %s\n", d_INT, d_REL);
! 396: printf("-> 1: %s\n\n", d_REL);
! 397:
! 398: printf(" 1: %s\n", d_CPL);
! 399: printf("-> 1: %s\n\n", d_CPL);
! 400:
! 401: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 402: printf("-> 1: %s\n\n", d_ALG);
! 403:
! 404: printf(" 1: %s\n", d_RPN);
! 405: printf("-> 1: %s\n", d_RPN);
! 406:
! 407: return;
! 408: }
! 409: else if ((*s_etat_processus).test_instruction == 'Y')
! 410: {
! 411: (*s_etat_processus).nombre_arguments = 1;
! 412: return;
! 413: }
! 414:
! 415: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 416: {
! 417: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 418: {
! 419: return;
! 420: }
! 421: }
! 422:
! 423: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 424: &s_objet_argument) == d_erreur)
! 425: {
! 426: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 427: return;
! 428: }
! 429:
! 430: /*
! 431: --------------------------------------------------------------------------------
! 432: Argch d'un entier ou d'un réel
! 433: --------------------------------------------------------------------------------
! 434: */
! 435:
! 436: if (((*s_objet_argument).type == INT) ||
! 437: ((*s_objet_argument).type == REL))
! 438: {
! 439: if ((*s_objet_argument).type == INT)
! 440: {
! 441: argument = (*((integer8 *) (*s_objet_argument).objet));
! 442: }
! 443: else
! 444: {
! 445: argument = (*((real8 *) (*s_objet_argument).objet));
! 446: }
! 447:
! 448: if (argument >= 1)
! 449: {
! 450: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 451: == NULL)
! 452: {
! 453: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 454: return;
! 455: }
! 456:
! 457: if ((*s_objet_argument).type == INT)
! 458: {
! 459: f77acoshi_((integer8 *) (*s_objet_argument).objet,
! 460: (real8 *) (*s_objet_resultat).objet);
! 461: }
! 462: else
! 463: {
! 464: f77acoshr_((real8 *) (*s_objet_argument).objet,
! 465: (real8 *) (*s_objet_resultat).objet);
! 466: }
! 467: }
! 468: else
! 469: {
! 470: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 471: == NULL)
! 472: {
! 473: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 474: return;
! 475: }
! 476:
! 477: if ((*s_objet_argument).type == INT)
! 478: {
! 479: registre.partie_reelle = (real8) (*((integer8 *)
! 480: (*s_objet_argument).objet));
! 481: }
! 482: else
! 483: {
! 484: registre.partie_reelle = (*((real8 *)
! 485: (*s_objet_argument).objet));
! 486: }
! 487:
! 488: registre.partie_imaginaire = 0;
! 489:
! 490: f77acoshc_(®istre, (struct_complexe16 *)
! 491: (*s_objet_resultat).objet);
! 492: }
! 493: }
! 494:
! 495: /*
! 496: --------------------------------------------------------------------------------
! 497: Argch d'un complexe
! 498: --------------------------------------------------------------------------------
! 499: */
! 500:
! 501: else if ((*s_objet_argument).type == CPL)
! 502: {
! 503: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 504: == NULL)
! 505: {
! 506: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 507: return;
! 508: }
! 509:
! 510: f77acoshc_((struct_complexe16 *) (*s_objet_argument).objet,
! 511: (struct_complexe16 *) (*s_objet_resultat).objet);
! 512: }
! 513:
! 514: /*
! 515: --------------------------------------------------------------------------------
! 516: Argch d'un nom
! 517: --------------------------------------------------------------------------------
! 518: */
! 519:
! 520: else if ((*s_objet_argument).type == NOM)
! 521: {
! 522: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 523: == NULL)
! 524: {
! 525: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 526: return;
! 527: }
! 528:
! 529: if (((*s_objet_resultat).objet =
! 530: allocation_maillon(s_etat_processus)) == NULL)
! 531: {
! 532: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 533: return;
! 534: }
! 535:
! 536: l_element_courant = (*s_objet_resultat).objet;
! 537:
! 538: if (((*l_element_courant).donnee =
! 539: allocation(s_etat_processus, FCT)) == NULL)
! 540: {
! 541: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 542: return;
! 543: }
! 544:
! 545: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 546: .nombre_arguments = 0;
! 547: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 548: .fonction = instruction_vers_niveau_superieur;
! 549:
! 550: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 551: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 552: {
! 553: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 554: return;
! 555: }
! 556:
! 557: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 558: .nom_fonction, "<<");
! 559:
! 560: if (((*l_element_courant).suivant =
! 561: allocation_maillon(s_etat_processus)) == NULL)
! 562: {
! 563: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 564: return;
! 565: }
! 566:
! 567: l_element_courant = (*l_element_courant).suivant;
! 568: (*l_element_courant).donnee = s_objet_argument;
! 569:
! 570: if (((*l_element_courant).suivant =
! 571: allocation_maillon(s_etat_processus)) == NULL)
! 572: {
! 573: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 574: return;
! 575: }
! 576:
! 577: l_element_courant = (*l_element_courant).suivant;
! 578:
! 579: if (((*l_element_courant).donnee =
! 580: allocation(s_etat_processus, FCT)) == NULL)
! 581: {
! 582: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 583: return;
! 584: }
! 585:
! 586: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 587: .nombre_arguments = 1;
! 588: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 589: .fonction = instruction_acosh;
! 590:
! 591: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 592: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
! 593: {
! 594: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 595: return;
! 596: }
! 597:
! 598: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 599: .nom_fonction, "ACOSH");
! 600:
! 601: if (((*l_element_courant).suivant =
! 602: allocation_maillon(s_etat_processus)) == NULL)
! 603: {
! 604: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 605: return;
! 606: }
! 607:
! 608: l_element_courant = (*l_element_courant).suivant;
! 609:
! 610: if (((*l_element_courant).donnee =
! 611: allocation(s_etat_processus, FCT)) == NULL)
! 612: {
! 613: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 614: return;
! 615: }
! 616:
! 617: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 618: .nombre_arguments = 0;
! 619: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 620: .fonction = instruction_vers_niveau_inferieur;
! 621:
! 622: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 623: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 624: {
! 625: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 626: return;
! 627: }
! 628:
! 629: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 630: .nom_fonction, ">>");
! 631:
! 632: (*l_element_courant).suivant = NULL;
! 633: s_objet_argument = NULL;
! 634: }
! 635:
! 636: /*
! 637: --------------------------------------------------------------------------------
! 638: Argch d'une expression
! 639: --------------------------------------------------------------------------------
! 640: */
! 641:
! 642: else if (((*s_objet_argument).type == ALG) ||
! 643: ((*s_objet_argument).type == RPN))
! 644: {
! 645: if ((s_copie_argument = copie_objet(s_etat_processus,
! 646: s_objet_argument, 'N')) == NULL)
! 647: {
! 648: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 649: return;
! 650: }
! 651:
! 652: l_element_courant = (struct_liste_chainee *)
! 653: (*s_copie_argument).objet;
! 654: l_element_precedent = l_element_courant;
! 655:
! 656: while((*l_element_courant).suivant != NULL)
! 657: {
! 658: l_element_precedent = l_element_courant;
! 659: l_element_courant = (*l_element_courant).suivant;
! 660: }
! 661:
! 662: if (((*l_element_precedent).suivant =
! 663: allocation_maillon(s_etat_processus)) == NULL)
! 664: {
! 665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 666: return;
! 667: }
! 668:
! 669: if (((*(*l_element_precedent).suivant).donnee =
! 670: allocation(s_etat_processus, FCT)) == NULL)
! 671: {
! 672: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 673: return;
! 674: }
! 675:
! 676: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 677: .donnee).objet)).nombre_arguments = 1;
! 678: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 679: .donnee).objet)).fonction = instruction_acosh;
! 680:
! 681: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 682: .suivant).donnee).objet)).nom_fonction =
! 683: malloc(6 * sizeof(unsigned char))) == NULL)
! 684: {
! 685: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 686: return;
! 687: }
! 688:
! 689: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 690: .suivant).donnee).objet)).nom_fonction, "ACOSH");
! 691:
! 692: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 693:
! 694: s_objet_resultat = s_copie_argument;
! 695: }
! 696:
! 697: /*
! 698: --------------------------------------------------------------------------------
! 699: Réalisation impossible de la fonction argch
! 700: --------------------------------------------------------------------------------
! 701: */
! 702:
! 703: else
! 704: {
! 705: liberation(s_etat_processus, s_objet_argument);
! 706:
! 707: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 708: return;
! 709: }
! 710:
! 711: liberation(s_etat_processus, s_objet_argument);
! 712:
! 713: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 714: s_objet_resultat) == d_erreur)
! 715: {
! 716: return;
! 717: }
! 718:
! 719: return;
! 720: }
! 721:
! 722:
! 723: /*
! 724: ================================================================================
! 725: Fonction 'atanh'
! 726: ================================================================================
! 727: Entrées : pointeur sur une structure struct_processus
! 728: --------------------------------------------------------------------------------
! 729: Sorties :
! 730: --------------------------------------------------------------------------------
! 731: Effets de bord : néant
! 732: ================================================================================
! 733: */
! 734:
! 735: void
! 736: instruction_atanh(struct_processus *s_etat_processus)
! 737: {
! 738: real8 argument;
! 739:
! 740: struct_complexe16 registre;
! 741:
! 742: struct_liste_chainee *l_element_courant;
! 743: struct_liste_chainee *l_element_precedent;
! 744:
! 745: struct_objet *s_copie_argument;
! 746: struct_objet *s_objet_argument;
! 747: struct_objet *s_objet_resultat;
! 748:
! 749: (*s_etat_processus).erreur_execution = d_ex;
! 750:
! 751: if ((*s_etat_processus).affichage_arguments == 'Y')
! 752: {
! 753: printf("\n ATANH ");
! 754:
! 755: if ((*s_etat_processus).langue == 'F')
! 756: {
! 757: printf("(argument de la tangente hyperbolique)\n\n");
! 758: }
! 759: else
! 760: {
! 761: printf("(hyperbolic tangent argument)\n\n");
! 762: }
! 763:
! 764: printf(" 1: %s, %s\n", d_INT, d_REL);
! 765: printf("-> 1: %s\n\n", d_REL);
! 766:
! 767: printf(" 1: %s\n", d_CPL);
! 768: printf("-> 1: %s\n\n", d_CPL);
! 769:
! 770: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 771: printf("-> 1: %s\n\n", d_ALG);
! 772:
! 773: printf(" 1: %s\n", d_RPN);
! 774: printf("-> 1: %s\n", d_RPN);
! 775:
! 776: return;
! 777: }
! 778: else if ((*s_etat_processus).test_instruction == 'Y')
! 779: {
! 780: (*s_etat_processus).nombre_arguments = 1;
! 781: return;
! 782: }
! 783:
! 784: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 785: {
! 786: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 787: {
! 788: return;
! 789: }
! 790: }
! 791:
! 792: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 793: &s_objet_argument) == d_erreur)
! 794: {
! 795: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 796: return;
! 797: }
! 798:
! 799: /*
! 800: --------------------------------------------------------------------------------
! 801: Argth d'un entier ou d'un réel
! 802: --------------------------------------------------------------------------------
! 803: */
! 804:
! 805: if (((*s_objet_argument).type == INT) ||
! 806: ((*s_objet_argument).type == REL))
! 807: {
! 808: if ((*s_objet_argument).type == INT)
! 809: {
! 810: argument = (*((integer8 *) (*s_objet_argument).objet));
! 811: }
! 812: else
! 813: {
! 814: argument = (*((real8 *) (*s_objet_argument).objet));
! 815: }
! 816:
! 817: if ((argument < 1) && (argument > -1))
! 818: {
! 819: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 820: == NULL)
! 821: {
! 822: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 823: return;
! 824: }
! 825:
! 826: if ((*s_objet_argument).type == INT)
! 827: {
! 828: f77atanhi_((integer8 *) (*s_objet_argument).objet,
! 829: (real8 *) (*s_objet_resultat).objet);
! 830: }
! 831: else
! 832: {
! 833: f77atanhr_((real8 *) (*s_objet_argument).objet,
! 834: (real8 *) (*s_objet_resultat).objet);
! 835: }
! 836: }
! 837: else if ((argument != 1) && (argument != -1))
! 838: {
! 839: if ((s_objet_resultat = allocation(s_etat_processus, CPL))
! 840: == NULL)
! 841: {
! 842: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 843: return;
! 844: }
! 845:
! 846: if ((*s_objet_argument).type == INT)
! 847: {
! 848: registre.partie_reelle = (real8) (*((integer8 *)
! 849: (*s_objet_argument).objet));
! 850: }
! 851: else
! 852: {
! 853: registre.partie_reelle = (*((real8 *)
! 854: (*s_objet_argument).objet));
! 855: }
! 856:
! 857: registre.partie_imaginaire = 0;
! 858:
! 859: f77atanhc_(®istre, (struct_complexe16 *)
! 860: (*s_objet_resultat).objet);
! 861: }
! 862: else
! 863: {
! 864: if (test_cfsf(s_etat_processus, 59) == d_vrai)
! 865: {
! 866: liberation(s_etat_processus, s_objet_argument);
! 867:
! 868: (*s_etat_processus).exception = d_ep_overflow;
! 869: return;
! 870: }
! 871: else
! 872: {
! 873: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 874: == NULL)
! 875: {
! 876: (*s_etat_processus).erreur_systeme =
! 877: d_es_allocation_memoire;
! 878: return;
! 879: }
! 880:
! 881: (*((real8 *) (*s_objet_resultat).objet)) =
! 882: ((double) 1) / ((double) 0);
! 883:
! 884: if (argument == -1)
! 885: {
! 886: (*((real8 *) (*s_objet_resultat).objet)) =
! 887: -(*((real8 *) (*s_objet_resultat).objet));
! 888: }
! 889: }
! 890: }
! 891: }
! 892:
! 893: /*
! 894: --------------------------------------------------------------------------------
! 895: Argth d'un complexe
! 896: --------------------------------------------------------------------------------
! 897: */
! 898:
! 899: else if ((*s_objet_argument).type == CPL)
! 900: {
! 901: if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
! 902: {
! 903: (*s_etat_processus).erreur_systeme =
! 904: d_es_allocation_memoire;
! 905: return;
! 906: }
! 907:
! 908: f77atanhc_((struct_complexe16 *) (*s_objet_argument).objet,
! 909: (struct_complexe16 *) (*s_objet_resultat).objet);
! 910: }
! 911:
! 912: /*
! 913: --------------------------------------------------------------------------------
! 914: Argth d'un nom
! 915: --------------------------------------------------------------------------------
! 916: */
! 917:
! 918: else if ((*s_objet_argument).type == NOM)
! 919: {
! 920: if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
! 921: {
! 922: (*s_etat_processus).erreur_systeme =
! 923: d_es_allocation_memoire;
! 924: return;
! 925: }
! 926:
! 927: if (((*s_objet_resultat).objet =
! 928: allocation_maillon(s_etat_processus)) == NULL)
! 929: {
! 930: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 931: return;
! 932: }
! 933:
! 934: l_element_courant = (*s_objet_resultat).objet;
! 935:
! 936: if (((*l_element_courant).donnee =
! 937: allocation(s_etat_processus, FCT)) == NULL)
! 938: {
! 939: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 940: return;
! 941: }
! 942:
! 943: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 944: .nombre_arguments = 0;
! 945: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 946: .fonction = instruction_vers_niveau_superieur;
! 947:
! 948: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 949: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 950: {
! 951: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 952: return;
! 953: }
! 954:
! 955: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 956: .nom_fonction, "<<");
! 957:
! 958: if (((*l_element_courant).suivant =
! 959: allocation_maillon(s_etat_processus)) == NULL)
! 960: {
! 961: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 962: return;
! 963: }
! 964:
! 965: l_element_courant = (*l_element_courant).suivant;
! 966: (*l_element_courant).donnee = s_objet_argument;
! 967:
! 968: if (((*l_element_courant).suivant =
! 969: allocation_maillon(s_etat_processus)) == NULL)
! 970: {
! 971: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 972: return;
! 973: }
! 974:
! 975: l_element_courant = (*l_element_courant).suivant;
! 976:
! 977: if (((*l_element_courant).donnee =
! 978: allocation(s_etat_processus, FCT)) == NULL)
! 979: {
! 980: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 981: return;
! 982: }
! 983:
! 984: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 985: .nombre_arguments = 1;
! 986: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 987: .fonction = instruction_atanh;
! 988:
! 989: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 990: .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
! 991: {
! 992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 993: return;
! 994: }
! 995:
! 996: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 997: .nom_fonction, "ATANH");
! 998:
! 999: if (((*l_element_courant).suivant =
! 1000: allocation_maillon(s_etat_processus)) == NULL)
! 1001: {
! 1002: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1003: return;
! 1004: }
! 1005:
! 1006: l_element_courant = (*l_element_courant).suivant;
! 1007:
! 1008: if (((*l_element_courant).donnee =
! 1009: allocation(s_etat_processus, FCT)) == NULL)
! 1010: {
! 1011: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1012: return;
! 1013: }
! 1014:
! 1015: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1016: .nombre_arguments = 0;
! 1017: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1018: .fonction = instruction_vers_niveau_inferieur;
! 1019:
! 1020: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1021: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1022: {
! 1023: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1024: return;
! 1025: }
! 1026:
! 1027: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1028: .nom_fonction, ">>");
! 1029:
! 1030: (*l_element_courant).suivant = NULL;
! 1031: s_objet_argument = NULL;
! 1032: }
! 1033:
! 1034: /*
! 1035: --------------------------------------------------------------------------------
! 1036: Argth d'une expression
! 1037: --------------------------------------------------------------------------------
! 1038: */
! 1039:
! 1040: else if (((*s_objet_argument).type == ALG) ||
! 1041: ((*s_objet_argument).type == RPN))
! 1042: {
! 1043: if ((s_copie_argument = copie_objet(s_etat_processus,
! 1044: s_objet_argument, 'N')) == NULL)
! 1045: {
! 1046: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1047: return;
! 1048: }
! 1049:
! 1050: l_element_courant = (struct_liste_chainee *)
! 1051: (*s_copie_argument).objet;
! 1052: l_element_precedent = l_element_courant;
! 1053:
! 1054: while((*l_element_courant).suivant != NULL)
! 1055: {
! 1056: l_element_precedent = l_element_courant;
! 1057: l_element_courant = (*l_element_courant).suivant;
! 1058: }
! 1059:
! 1060: if (((*l_element_precedent).suivant =
! 1061: allocation_maillon(s_etat_processus)) == NULL)
! 1062: {
! 1063: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1064: return;
! 1065: }
! 1066:
! 1067: if (((*(*l_element_precedent).suivant).donnee =
! 1068: allocation(s_etat_processus, FCT)) == NULL)
! 1069: {
! 1070: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1071: return;
! 1072: }
! 1073:
! 1074: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1075: .donnee).objet)).nombre_arguments = 1;
! 1076: (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
! 1077: .donnee).objet)).fonction = instruction_atanh;
! 1078:
! 1079: if (((*((struct_fonction *) (*(*(*l_element_precedent)
! 1080: .suivant).donnee).objet)).nom_fonction =
! 1081: malloc(6 * sizeof(unsigned char))) == NULL)
! 1082: {
! 1083: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1084: return;
! 1085: }
! 1086:
! 1087: strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
! 1088: .suivant).donnee).objet)).nom_fonction, "ATANH");
! 1089:
! 1090: (*(*l_element_precedent).suivant).suivant = l_element_courant;
! 1091:
! 1092: s_objet_resultat = s_copie_argument;
! 1093: }
! 1094:
! 1095: /*
! 1096: --------------------------------------------------------------------------------
! 1097: Réalisation impossible de la fonction argth
! 1098: --------------------------------------------------------------------------------
! 1099: */
! 1100:
! 1101: else
! 1102: {
! 1103: liberation(s_etat_processus, s_objet_argument);
! 1104:
! 1105: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1106: return;
! 1107: }
! 1108:
! 1109: liberation(s_etat_processus, s_objet_argument);
! 1110:
! 1111: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1112: s_objet_resultat) == d_erreur)
! 1113: {
! 1114: return;
! 1115: }
! 1116:
! 1117: return;
! 1118: }
! 1119:
! 1120: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_a2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src