![]() ![]() | ![]() |
Passage de la branche 4.1 en branche stable.
1: /* 2: ================================================================================ 3: RPL/2 (R) version 4.1.0 4: Copyright (C) 1989-2011 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