Annotation of rpl/src/instructions_b1.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 'bin'
! 29: ================================================================================
! 30: Entrées :
! 31: --------------------------------------------------------------------------------
! 32: Sorties :
! 33: --------------------------------------------------------------------------------
! 34: Effets de bord : néant
! 35: ================================================================================
! 36: */
! 37:
! 38: void
! 39: instruction_bin(struct_processus *s_etat_processus)
! 40: {
! 41: (*s_etat_processus).erreur_execution = d_ex;
! 42:
! 43: if ((*s_etat_processus).affichage_arguments == 'Y')
! 44: {
! 45: printf("\n BIN ");
! 46:
! 47: if ((*s_etat_processus).langue == 'F')
! 48: {
! 49: printf("(base binaire)\n\n");
! 50: printf(" Aucun argument\n");
! 51: }
! 52: else
! 53: {
! 54: printf("(binary base)\n\n");
! 55: printf(" No argument\n");
! 56: }
! 57:
! 58: return;
! 59: }
! 60: else if ((*s_etat_processus).test_instruction == 'Y')
! 61: {
! 62: (*s_etat_processus).nombre_arguments = -1;
! 63: return;
! 64: }
! 65:
! 66: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 67: {
! 68: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 69: {
! 70: return;
! 71: }
! 72: }
! 73:
! 74: cf(s_etat_processus, 43);
! 75: sf(s_etat_processus, 44);
! 76:
! 77: return;
! 78: }
! 79:
! 80:
! 81: /*
! 82: ================================================================================
! 83: Fonction 'beep'
! 84: ================================================================================
! 85: Entrées :
! 86: --------------------------------------------------------------------------------
! 87: Sorties :
! 88: --------------------------------------------------------------------------------
! 89: Effets de bord : néant
! 90: ================================================================================
! 91: */
! 92:
! 93: void
! 94: instruction_beep(struct_processus *s_etat_processus)
! 95: {
! 96: (*s_etat_processus).erreur_execution = d_ex;
! 97:
! 98: if ((*s_etat_processus).affichage_arguments == 'Y')
! 99: {
! 100: printf("\n BEEP ");
! 101:
! 102: if ((*s_etat_processus).langue == 'F')
! 103: {
! 104: printf("(son d'avertissement)\n\n");
! 105: printf(" Aucun argument\n");
! 106: }
! 107: else
! 108: {
! 109: printf("(warning bell)\n\n");
! 110: printf(" No argument\n");
! 111: }
! 112:
! 113: return;
! 114: }
! 115: else if ((*s_etat_processus).test_instruction == 'Y')
! 116: {
! 117: (*s_etat_processus).nombre_arguments = -1;
! 118: return;
! 119: }
! 120:
! 121: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 122: {
! 123: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 124: {
! 125: return;
! 126: }
! 127: }
! 128:
! 129: if (test_cfsf(s_etat_processus, 51) == d_faux)
! 130: {
! 131: printf("%s", ds_beep);
! 132: }
! 133:
! 134: return;
! 135: }
! 136:
! 137:
! 138: /*
! 139: ================================================================================
! 140: Fonction 'b->r'
! 141: ================================================================================
! 142: Entrées : pointeur sur une structure struct_processus
! 143: --------------------------------------------------------------------------------
! 144: Sorties :
! 145: --------------------------------------------------------------------------------
! 146: Effets de bord : néant
! 147: ================================================================================
! 148: */
! 149:
! 150: void
! 151: instruction_b_vers_r(struct_processus *s_etat_processus)
! 152: {
! 153: struct_objet *s_objet_argument;
! 154: struct_objet *s_objet_resultat;
! 155:
! 156: (*s_etat_processus).erreur_execution = d_ex;
! 157:
! 158: if ((*s_etat_processus).affichage_arguments == 'Y')
! 159: {
! 160: printf("\n B->R ");
! 161:
! 162: if ((*s_etat_processus).langue == 'F')
! 163: {
! 164: printf("(binaire vers réel)\n\n");
! 165: }
! 166: else
! 167: {
! 168: printf("(binary to real)\n\n");
! 169: }
! 170:
! 171: printf(" 1: %s\n", d_BIN);
! 172: printf("-> 1: %s\n", d_INT);
! 173:
! 174: return;
! 175: }
! 176: else if ((*s_etat_processus).test_instruction == 'Y')
! 177: {
! 178: (*s_etat_processus).nombre_arguments = -1;
! 179: return;
! 180: }
! 181:
! 182: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 183: {
! 184: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 185: {
! 186: return;
! 187: }
! 188: }
! 189:
! 190: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 191: &s_objet_argument) == d_erreur)
! 192: {
! 193: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 194: return;
! 195: }
! 196:
! 197: if ((*s_objet_argument).type == BIN)
! 198: {
! 199: if ((s_objet_resultat = allocation(s_etat_processus, INT))
! 200: == NULL)
! 201: {
! 202: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 203: return;
! 204: }
! 205:
! 206: (*((integer8 *) (*s_objet_resultat).objet)) = (*((logical8 *)
! 207: (*s_objet_argument).objet));
! 208: }
! 209: else
! 210: {
! 211: liberation(s_etat_processus, s_objet_argument);
! 212:
! 213: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 214: return;
! 215: }
! 216:
! 217: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 218: s_objet_resultat) == d_erreur)
! 219: {
! 220: return;
! 221: }
! 222:
! 223: liberation(s_etat_processus, s_objet_argument);
! 224:
! 225: return;
! 226: }
! 227:
! 228:
! 229: /*
! 230: ================================================================================
! 231: Fonction 'backspace'
! 232: ================================================================================
! 233: Entrées :
! 234: --------------------------------------------------------------------------------
! 235: Sorties :
! 236: --------------------------------------------------------------------------------
! 237: Effets de bord : néant
! 238: ================================================================================
! 239: */
! 240:
! 241: void
! 242: instruction_backspace(struct_processus *s_etat_processus)
! 243: {
! 244: file *descripteur;
! 245:
! 246: integer8 position_finale;
! 247: integer8 position_initiale;
! 248:
! 249: logical1 presence_chaine;
! 250: logical1 presence_indicateur;
! 251:
! 252: long pointeur;
! 253: long niveau;
! 254:
! 255: size_t longueur_effective;
! 256: size_t longueur_questure;
! 257:
! 258: struct flock lock;
! 259:
! 260: struct_objet *s_objet_argument;
! 261:
! 262: unsigned char *tampon_lecture;
! 263:
! 264: (*s_etat_processus).erreur_execution = d_ex;
! 265:
! 266: if ((*s_etat_processus).affichage_arguments == 'Y')
! 267: {
! 268: printf("\n BACKSPACE ");
! 269:
! 270: if ((*s_etat_processus).langue == 'F')
! 271: {
! 272: printf("(retour à l'enregistrement précédent)\n\n");
! 273: }
! 274: else
! 275: {
! 276: printf("(return to the previous record)\n\n");
! 277: }
! 278:
! 279: printf(" 1: %s\n", d_FCH);
! 280:
! 281: return;
! 282: }
! 283: else if ((*s_etat_processus).test_instruction == 'Y')
! 284: {
! 285: (*s_etat_processus).nombre_arguments = -1;
! 286: return;
! 287: }
! 288:
! 289: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 290: {
! 291: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 292: {
! 293: return;
! 294: }
! 295: }
! 296:
! 297: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 298: &s_objet_argument) == d_erreur)
! 299: {
! 300: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 301: return;
! 302: }
! 303:
! 304: if ((*s_objet_argument).type == FCH)
! 305: {
! 306: /*
! 307: * Vérification des verrous
! 308: */
! 309:
! 310: lock.l_type = F_RDLCK;
! 311: lock.l_whence = SEEK_SET;
! 312: lock.l_start = 0;
! 313: lock.l_len = 0;
! 314: lock.l_pid = getpid();
! 315:
! 316: if ((descripteur = descripteur_fichier(s_etat_processus,
! 317: (struct_fichier *) (*s_objet_argument).objet)) == NULL)
! 318: {
! 319: liberation(s_etat_processus, s_objet_argument);
! 320: return;
! 321: }
! 322:
! 323: if (fcntl(fileno(descripteur), F_GETLK, &lock) == -1)
! 324: {
! 325: liberation(s_etat_processus, s_objet_argument);
! 326:
! 327: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 328: return;
! 329: }
! 330:
! 331: if (lock.l_type != F_UNLCK)
! 332: {
! 333: liberation(s_etat_processus, s_objet_argument);
! 334:
! 335: (*s_etat_processus).erreur_execution =
! 336: d_ex_fichier_verrouille;
! 337: return;
! 338: }
! 339:
! 340: if ((*((struct_fichier *) (*s_objet_argument).objet)).acces == 'S')
! 341: {
! 342: /*
! 343: * Fichiers à accès séquentiel
! 344: */
! 345:
! 346: if ((*((struct_fichier *) (*s_objet_argument).objet)).binaire
! 347: == 'N')
! 348: {
! 349: /*
! 350: * Fichiers formatés
! 351: */
! 352:
! 353: if ((position_finale = ftell(descripteur)) == -1)
! 354: {
! 355: liberation(s_etat_processus, s_objet_argument);
! 356:
! 357: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 358: return;
! 359: }
! 360:
! 361: longueur_questure = 256;
! 362:
! 363: if ((tampon_lecture = malloc(longueur_questure *
! 364: sizeof(unsigned char))) == NULL)
! 365: {
! 366: (*s_etat_processus).erreur_systeme =
! 367: d_es_allocation_memoire;
! 368: return;
! 369: }
! 370:
! 371: do
! 372: {
! 373: if ((position_initiale = (position_finale -
! 374: longueur_questure)) < 0)
! 375: {
! 376: position_initiale = 0;
! 377: longueur_effective = position_finale + 1;
! 378: }
! 379: else
! 380: {
! 381: longueur_effective = longueur_questure;
! 382: }
! 383:
! 384: if (fseek(descripteur, position_initiale, SEEK_SET) != 0)
! 385: {
! 386: (*s_etat_processus).erreur_systeme =
! 387: d_es_erreur_fichier;
! 388: return;
! 389: }
! 390:
! 391: longueur_effective = fread(tampon_lecture,
! 392: (size_t) sizeof(unsigned char), longueur_effective,
! 393: descripteur);
! 394:
! 395: pointeur = longueur_effective - 1;
! 396: presence_indicateur = d_faux;
! 397:
! 398: while((pointeur >= 0) && (presence_indicateur == d_faux))
! 399: {
! 400: if (tampon_lecture[pointeur] == '}')
! 401: {
! 402: presence_indicateur = d_vrai;
! 403: }
! 404: else
! 405: {
! 406: position_finale--;
! 407: pointeur--;
! 408: }
! 409: }
! 410: } while((longueur_effective == longueur_questure) &&
! 411: (presence_indicateur == d_faux));
! 412:
! 413: if (presence_indicateur == d_faux)
! 414: {
! 415: /*
! 416: * Le début du fichier est atteint.
! 417: */
! 418:
! 419: if (fseek(descripteur, 0, SEEK_SET) != 0)
! 420: {
! 421: liberation(s_etat_processus, s_objet_argument);
! 422: free(tampon_lecture);
! 423:
! 424: (*s_etat_processus).erreur_systeme =
! 425: d_es_erreur_fichier;
! 426: return;
! 427: }
! 428:
! 429: (*s_etat_processus).erreur_execution =
! 430: d_ex_debut_de_fichier_atteint;
! 431:
! 432: liberation(s_etat_processus, s_objet_argument);
! 433: free(tampon_lecture);
! 434:
! 435: return;
! 436: }
! 437:
! 438: position_finale = position_finale - 1;
! 439: presence_chaine = d_faux;
! 440: niveau = 1;
! 441:
! 442: if (position_finale < 0)
! 443: {
! 444: liberation(s_etat_processus, s_objet_argument);
! 445: free(tampon_lecture);
! 446:
! 447: (*s_etat_processus).erreur_execution =
! 448: d_ex_debut_de_fichier_atteint;
! 449: return;
! 450: }
! 451:
! 452: do
! 453: {
! 454: if ((position_initiale = (position_finale -
! 455: longueur_questure)) < 0)
! 456: {
! 457: position_initiale = 0;
! 458: longueur_effective = position_finale + 1;
! 459: }
! 460: else
! 461: {
! 462: longueur_effective = longueur_questure;
! 463: position_finale--;
! 464: }
! 465:
! 466: if (fseek(descripteur, position_initiale, SEEK_SET) != 0)
! 467: {
! 468: (*s_etat_processus).erreur_systeme =
! 469: d_es_erreur_fichier;
! 470: return;
! 471: }
! 472:
! 473: longueur_effective = fread(tampon_lecture,
! 474: (size_t) sizeof(unsigned char), longueur_effective,
! 475: descripteur);
! 476:
! 477: pointeur = longueur_effective - 1;
! 478: presence_indicateur = d_faux;
! 479:
! 480: while((pointeur >= 0) && (presence_indicateur == d_faux))
! 481: {
! 482: if (tampon_lecture[pointeur] == '"')
! 483: {
! 484: presence_chaine = (presence_chaine == d_vrai)
! 485: ? d_faux : d_vrai;
! 486: }
! 487: else
! 488: {
! 489: if (tampon_lecture[pointeur] == '}')
! 490: {
! 491: niveau++;
! 492: }
! 493: else if (tampon_lecture[pointeur] == '{')
! 494: {
! 495: niveau--;
! 496: }
! 497: }
! 498:
! 499: if (niveau == 0)
! 500: {
! 501: presence_indicateur = d_vrai;
! 502: }
! 503: else
! 504: {
! 505: position_finale--;
! 506: pointeur--;
! 507: }
! 508: }
! 509: } while((longueur_effective == longueur_questure) &&
! 510: (presence_indicateur == d_faux));
! 511:
! 512: if (presence_indicateur == d_faux)
! 513: {
! 514: liberation(s_etat_processus, s_objet_argument);
! 515: free(tampon_lecture);
! 516:
! 517: (*s_etat_processus).erreur_execution =
! 518: d_ex_fin_de_fichier_atteinte;
! 519: return;
! 520: }
! 521:
! 522: if (fseek(descripteur, position_finale, SEEK_SET) != 0)
! 523: {
! 524: liberation(s_etat_processus, s_objet_argument);
! 525: free(tampon_lecture);
! 526:
! 527: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 528: return;
! 529: }
! 530:
! 531: free(tampon_lecture);
! 532: }
! 533: else
! 534: {
! 535: /*
! 536: * Fichiers non formatés
! 537: */
! 538: }
! 539: }
! 540: else
! 541: {
! 542: liberation(s_etat_processus, s_objet_argument);
! 543:
! 544: (*s_etat_processus).erreur_execution = d_ex_erreur_type_fichier;
! 545: return;
! 546: }
! 547: }
! 548: else
! 549: {
! 550: liberation(s_etat_processus, s_objet_argument);
! 551:
! 552: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 553: return;
! 554: }
! 555:
! 556: liberation(s_etat_processus, s_objet_argument);
! 557:
! 558: return;
! 559: }
! 560:
! 561:
! 562: /*
! 563: ================================================================================
! 564: Fonction 'bessel'
! 565: ================================================================================
! 566: Entrées :
! 567: --------------------------------------------------------------------------------
! 568: Sorties :
! 569: --------------------------------------------------------------------------------
! 570: Effets de bord : néant
! 571: ================================================================================
! 572: */
! 573:
! 574: void
! 575: instruction_bessel(struct_processus *s_etat_processus)
! 576: {
! 577: logical1 creation_expression;
! 578:
! 579: struct_liste_chainee *l_element_atome;
! 580: struct_liste_chainee *l_element_courant;
! 581: struct_liste_chainee *l_element_precedent;
! 582:
! 583: struct_objet *s_copie_argument_1;
! 584: struct_objet *s_copie_argument_2;
! 585: struct_objet *s_copie_argument_3;
! 586: struct_objet *s_objet_argument_1;
! 587: struct_objet *s_objet_argument_2;
! 588: struct_objet *s_objet_argument_3;
! 589: struct_objet *s_objet_resultat;
! 590:
! 591: unsigned long i;
! 592:
! 593: (*s_etat_processus).erreur_execution = d_ex;
! 594:
! 595: if ((*s_etat_processus).affichage_arguments == 'Y')
! 596: {
! 597: printf("\n BESSEL ");
! 598:
! 599: if ((*s_etat_processus).langue == 'F')
! 600: {
! 601: printf("(fonctions de Bessel)\n\n");
! 602: }
! 603: else
! 604: {
! 605: printf("(Bessel functions)\n\n");
! 606: }
! 607:
! 608: printf(" 3: \"J\", \"Y\", \"I\", \"K\", \"j\", \"y\", "
! 609: "\"i\", \"k\"\n");
! 610: printf(" 2: %s, %s\n", d_INT, d_REL);
! 611: printf(" 1: %s, %s\n", d_INT, d_REL);
! 612: printf("-> 1: %s\n\n", d_REL);
! 613:
! 614: printf(" 3: \"J\", \"Y\", \"I\", \"K\", \"j\", \"y\", "
! 615: "\"i\", \"k\"\n");
! 616: printf(" 2: %s, %s\n", d_INT, d_REL);
! 617: printf(" 1: %s, %s\n", d_NOM, d_ALG);
! 618: printf("-> 1: %s\n\n", d_ALG);
! 619:
! 620: printf(" 3: \"J\", \"Y\", \"I\", \"K\", \"j\", \"y\", "
! 621: "\"i\", \"k\"\n");
! 622: printf(" 2: %s, %s\n", d_INT, d_REL);
! 623: printf(" 1: %s\n", d_RPN);
! 624: printf("-> 1: %s\n", d_RPN);
! 625: return;
! 626: }
! 627: else if ((*s_etat_processus).test_instruction == 'Y')
! 628: {
! 629: (*s_etat_processus).nombre_arguments = 3;
! 630: return;
! 631: }
! 632:
! 633: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 634: {
! 635: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
! 636: {
! 637: return;
! 638: }
! 639: }
! 640:
! 641: /*
! 642: * Jn fonction cylindrique régulière
! 643: * Yn fonction cylindrique irrégulière
! 644: * In fonction cylindrique régulière modifiée
! 645: * Kn fonction cylindrique irrégulière modifiée
! 646: * jn fonction sphérique régulière
! 647: * yn fonction sphérique irrégulière
! 648: * in fonction sphérique régulière modifiée
! 649: * kn fonction sphérique irrégulière modifiée
! 650: *
! 651: * Attention : Ordre fractionnaire uniquement pour les
! 652: * fonctions cylindriques
! 653: */
! 654:
! 655: creation_expression = d_faux;
! 656:
! 657: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 658: &s_objet_argument_1) == d_erreur)
! 659: {
! 660: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 661: return;
! 662: }
! 663:
! 664: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 665: &s_objet_argument_2) == d_erreur)
! 666: {
! 667: liberation(s_etat_processus, s_objet_argument_1);
! 668:
! 669: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 670: return;
! 671: }
! 672:
! 673: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 674: &s_objet_argument_3) == d_erreur)
! 675: {
! 676: liberation(s_etat_processus, s_objet_argument_1);
! 677: liberation(s_etat_processus, s_objet_argument_2);
! 678:
! 679: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 680: return;
! 681: }
! 682:
! 683: if ((*s_objet_argument_3).type == CHN)
! 684: {
! 685: if ((strcmp((unsigned char *) (*s_objet_argument_3).objet, "J") == 0) ||
! 686: (strcmp((unsigned char *) (*s_objet_argument_3).objet, "Y")
! 687: == 0) || (strcmp((unsigned char *) (*s_objet_argument_3).objet,
! 688: "I") == 0) || (strcmp((unsigned char *) (*s_objet_argument_3)
! 689: .objet, "K") == 0) || (strcmp((unsigned char *)
! 690: (*s_objet_argument_3).objet, "j") == 0) || (strcmp(
! 691: (unsigned char *) (*s_objet_argument_3).objet, "y") == 0) ||
! 692: (strcmp((unsigned char *) (*s_objet_argument_3).objet, "i") ==
! 693: 0) || (strcmp((unsigned char *) (*s_objet_argument_3).objet,
! 694: "k") == 0))
! 695: {
! 696: if ((*s_objet_argument_2).type == INT)
! 697: {
! 698: if ((*s_objet_argument_1).type == INT)
! 699: {
! 700: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 701: == NULL)
! 702: {
! 703: (*s_etat_processus).erreur_systeme =
! 704: d_es_allocation_memoire;
! 705: return;
! 706: }
! 707:
! 708: switch((*((unsigned char *) (*s_objet_argument_3).objet)))
! 709: {
! 710: case 'J' :
! 711: {
! 712: (*((real8 *) (*s_objet_resultat).objet)) =
! 713: gsl_sf_bessel_Jn((int) ((*((integer8 *)
! 714: (*s_objet_argument_2).objet))),
! 715: (double) ((*((integer8 *)
! 716: (*s_objet_argument_1).objet))));
! 717: break;
! 718: }
! 719:
! 720: case 'Y' :
! 721: {
! 722: if ((*((integer8 *) (*s_objet_argument_1).objet))
! 723: <= 0)
! 724: {
! 725: (*s_etat_processus).exception =
! 726: d_ep_resultat_indefini;
! 727:
! 728: liberation(s_etat_processus,
! 729: s_objet_argument_1);
! 730: liberation(s_etat_processus,
! 731: s_objet_argument_2);
! 732: liberation(s_etat_processus,
! 733: s_objet_argument_3);
! 734: liberation(s_etat_processus,
! 735: s_objet_resultat);
! 736:
! 737: return;
! 738: }
! 739:
! 740: (*((real8 *) (*s_objet_resultat).objet)) =
! 741: gsl_sf_bessel_Yn((int) ((*((integer8 *)
! 742: (*s_objet_argument_2).objet))),
! 743: (double) ((*((integer8 *)
! 744: (*s_objet_argument_1).objet))));
! 745: break;
! 746: }
! 747:
! 748: case 'I' :
! 749: {
! 750: (*((real8 *) (*s_objet_resultat).objet)) =
! 751: gsl_sf_bessel_In((int) ((*((integer8 *)
! 752: (*s_objet_argument_2).objet))),
! 753: (double) ((*((integer8 *)
! 754: (*s_objet_argument_1).objet))));
! 755: break;
! 756: }
! 757:
! 758: case 'K' :
! 759: {
! 760: if ((*((integer8 *) (*s_objet_argument_1).objet))
! 761: <= 0)
! 762: {
! 763: (*s_etat_processus).exception =
! 764: d_ep_resultat_indefini;
! 765:
! 766: liberation(s_etat_processus,
! 767: s_objet_argument_1);
! 768: liberation(s_etat_processus,
! 769: s_objet_argument_2);
! 770: liberation(s_etat_processus,
! 771: s_objet_argument_3);
! 772: liberation(s_etat_processus,
! 773: s_objet_resultat);
! 774:
! 775: return;
! 776: }
! 777:
! 778: (*((real8 *) (*s_objet_resultat).objet)) =
! 779: gsl_sf_bessel_Kn((int) ((*((integer8 *)
! 780: (*s_objet_argument_2).objet))),
! 781: (double) ((*((integer8 *)
! 782: (*s_objet_argument_1).objet))));
! 783: break;
! 784: }
! 785:
! 786: case 'j' :
! 787: {
! 788: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 789: < 0) || ((*((integer8 *)
! 790: (*s_objet_argument_2).objet)) < 0))
! 791: {
! 792: (*s_etat_processus).exception =
! 793: d_ep_resultat_indefini;
! 794:
! 795: liberation(s_etat_processus,
! 796: s_objet_argument_1);
! 797: liberation(s_etat_processus,
! 798: s_objet_argument_2);
! 799: liberation(s_etat_processus,
! 800: s_objet_argument_3);
! 801: liberation(s_etat_processus,
! 802: s_objet_resultat);
! 803:
! 804: return;
! 805: }
! 806:
! 807: (*((real8 *) (*s_objet_resultat).objet)) =
! 808: gsl_sf_bessel_jl((int) ((*((integer8 *)
! 809: (*s_objet_argument_2).objet))),
! 810: (double) ((*((integer8 *)
! 811: (*s_objet_argument_1).objet))));
! 812: break;
! 813: }
! 814:
! 815: case 'y' :
! 816: {
! 817: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 818: <= 0) || ((*((integer8 *)
! 819: (*s_objet_argument_2).objet)) < 0))
! 820: {
! 821: (*s_etat_processus).exception =
! 822: d_ep_resultat_indefini;
! 823:
! 824: liberation(s_etat_processus,
! 825: s_objet_argument_1);
! 826: liberation(s_etat_processus,
! 827: s_objet_argument_2);
! 828: liberation(s_etat_processus,
! 829: s_objet_argument_3);
! 830: liberation(s_etat_processus,
! 831: s_objet_resultat);
! 832:
! 833: return;
! 834: }
! 835:
! 836: (*((real8 *) (*s_objet_resultat).objet)) =
! 837: gsl_sf_bessel_yl((int) ((*((integer8 *)
! 838: (*s_objet_argument_2).objet))),
! 839: (double) ((*((integer8 *)
! 840: (*s_objet_argument_1).objet))));
! 841: break;
! 842: }
! 843:
! 844: case 'i' :
! 845: {
! 846: if ((*((integer8 *) (*s_objet_argument_2).objet))
! 847: < 0)
! 848: {
! 849: (*s_etat_processus).exception =
! 850: d_ep_resultat_indefini;
! 851:
! 852: liberation(s_etat_processus,
! 853: s_objet_argument_1);
! 854: liberation(s_etat_processus,
! 855: s_objet_argument_2);
! 856: liberation(s_etat_processus,
! 857: s_objet_argument_3);
! 858: liberation(s_etat_processus,
! 859: s_objet_resultat);
! 860:
! 861: return;
! 862: }
! 863:
! 864: (*((real8 *) (*s_objet_resultat).objet)) =
! 865: exp(fabs((double) (*((integer8 *)
! 866: (*s_objet_argument_1).objet)))) *
! 867: gsl_sf_bessel_il_scaled(
! 868: (int) ((*((integer8 *)
! 869: (*s_objet_argument_2).objet))),
! 870: (double) ((*((integer8 *)
! 871: (*s_objet_argument_1).objet))));
! 872: break;
! 873: }
! 874:
! 875: case 'k' :
! 876: {
! 877: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 878: <= 0) || ((*((integer8 *)
! 879: (*s_objet_argument_2).objet)) < 0))
! 880: {
! 881: (*s_etat_processus).exception =
! 882: d_ep_resultat_indefini;
! 883:
! 884: liberation(s_etat_processus,
! 885: s_objet_argument_1);
! 886: liberation(s_etat_processus,
! 887: s_objet_argument_2);
! 888: liberation(s_etat_processus,
! 889: s_objet_argument_3);
! 890: liberation(s_etat_processus,
! 891: s_objet_resultat);
! 892:
! 893: return;
! 894: }
! 895:
! 896: (*((real8 *) (*s_objet_resultat).objet)) =
! 897: exp(fabs((double) (*((integer8 *)
! 898: (*s_objet_argument_1).objet)))) *
! 899: gsl_sf_bessel_kl_scaled(
! 900: (int) ((*((integer8 *)
! 901: (*s_objet_argument_2).objet))),
! 902: (double) ((*((integer8 *)
! 903: (*s_objet_argument_1).objet))));
! 904: break;
! 905: }
! 906: }
! 907: }
! 908: else if ((*s_objet_argument_1).type == REL)
! 909: {
! 910: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 911: == NULL)
! 912: {
! 913: (*s_etat_processus).erreur_systeme =
! 914: d_es_allocation_memoire;
! 915: return;
! 916: }
! 917:
! 918: switch((*((unsigned char *) (*s_objet_argument_3).objet)))
! 919: {
! 920: case 'J' :
! 921: {
! 922: (*((real8 *) (*s_objet_resultat).objet)) =
! 923: gsl_sf_bessel_Jn((int) ((*((integer8 *)
! 924: (*s_objet_argument_2).objet))),
! 925: (double) ((*((real8 *)
! 926: (*s_objet_argument_1).objet))));
! 927: break;
! 928: }
! 929:
! 930: case 'Y' :
! 931: {
! 932: if ((*((real8 *) (*s_objet_argument_1).objet))
! 933: <= 0)
! 934: {
! 935: (*s_etat_processus).exception =
! 936: d_ep_resultat_indefini;
! 937:
! 938: liberation(s_etat_processus,
! 939: s_objet_argument_1);
! 940: liberation(s_etat_processus,
! 941: s_objet_argument_2);
! 942: liberation(s_etat_processus,
! 943: s_objet_argument_3);
! 944: liberation(s_etat_processus,
! 945: s_objet_resultat);
! 946:
! 947: return;
! 948: }
! 949:
! 950: (*((real8 *) (*s_objet_resultat).objet)) =
! 951: gsl_sf_bessel_Yn((int) ((*((integer8 *)
! 952: (*s_objet_argument_2).objet))),
! 953: (double) ((*((real8 *)
! 954: (*s_objet_argument_1).objet))));
! 955: break;
! 956: }
! 957:
! 958: case 'I' :
! 959: {
! 960: (*((real8 *) (*s_objet_resultat).objet)) =
! 961: gsl_sf_bessel_In((int) ((*((integer8 *)
! 962: (*s_objet_argument_2).objet))),
! 963: (double) ((*((real8 *)
! 964: (*s_objet_argument_1).objet))));
! 965: break;
! 966: }
! 967:
! 968: case 'K' :
! 969: {
! 970: if ((*((real8 *) (*s_objet_argument_1).objet))
! 971: <= 0)
! 972: {
! 973: (*s_etat_processus).exception =
! 974: d_ep_resultat_indefini;
! 975:
! 976: liberation(s_etat_processus,
! 977: s_objet_argument_1);
! 978: liberation(s_etat_processus,
! 979: s_objet_argument_2);
! 980: liberation(s_etat_processus,
! 981: s_objet_argument_3);
! 982: liberation(s_etat_processus,
! 983: s_objet_resultat);
! 984:
! 985: return;
! 986: }
! 987:
! 988: (*((real8 *) (*s_objet_resultat).objet)) =
! 989: gsl_sf_bessel_Kn((int) ((*((integer8 *)
! 990: (*s_objet_argument_2).objet))),
! 991: (double) ((*((real8 *)
! 992: (*s_objet_argument_1).objet))));
! 993: break;
! 994: }
! 995:
! 996: case 'j' :
! 997: {
! 998: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 999: < 0) || ((*((integer8 *)
! 1000: (*s_objet_argument_2).objet)) < 0))
! 1001: {
! 1002: (*s_etat_processus).exception =
! 1003: d_ep_resultat_indefini;
! 1004:
! 1005: liberation(s_etat_processus,
! 1006: s_objet_argument_1);
! 1007: liberation(s_etat_processus,
! 1008: s_objet_argument_2);
! 1009: liberation(s_etat_processus,
! 1010: s_objet_argument_3);
! 1011: liberation(s_etat_processus,
! 1012: s_objet_resultat);
! 1013:
! 1014: return;
! 1015: }
! 1016:
! 1017: (*((real8 *) (*s_objet_resultat).objet)) =
! 1018: gsl_sf_bessel_jl((int) ((*((integer8 *)
! 1019: (*s_objet_argument_2).objet))),
! 1020: (double) ((*((real8 *)
! 1021: (*s_objet_argument_1).objet))));
! 1022: break;
! 1023: }
! 1024:
! 1025: case 'y' :
! 1026: {
! 1027: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 1028: <= 0) || ((*((integer8 *)
! 1029: (*s_objet_argument_2).objet)) < 0))
! 1030: {
! 1031: (*s_etat_processus).exception =
! 1032: d_ep_resultat_indefini;
! 1033:
! 1034: liberation(s_etat_processus,
! 1035: s_objet_argument_1);
! 1036: liberation(s_etat_processus,
! 1037: s_objet_argument_2);
! 1038: liberation(s_etat_processus,
! 1039: s_objet_argument_3);
! 1040: liberation(s_etat_processus,
! 1041: s_objet_resultat);
! 1042:
! 1043: return;
! 1044: }
! 1045:
! 1046: (*((real8 *) (*s_objet_resultat).objet)) =
! 1047: gsl_sf_bessel_yl((int) ((*((integer8 *)
! 1048: (*s_objet_argument_2).objet))),
! 1049: (double) ((*((real8 *)
! 1050: (*s_objet_argument_1).objet))));
! 1051: break;
! 1052: }
! 1053:
! 1054: case 'i' :
! 1055: {
! 1056: if ((*((integer8 *) (*s_objet_argument_2).objet))
! 1057: < 0)
! 1058: {
! 1059: (*s_etat_processus).exception =
! 1060: d_ep_resultat_indefini;
! 1061:
! 1062: liberation(s_etat_processus,
! 1063: s_objet_argument_1);
! 1064: liberation(s_etat_processus,
! 1065: s_objet_argument_2);
! 1066: liberation(s_etat_processus,
! 1067: s_objet_argument_3);
! 1068: liberation(s_etat_processus,
! 1069: s_objet_resultat);
! 1070:
! 1071: return;
! 1072: }
! 1073:
! 1074: (*((real8 *) (*s_objet_resultat).objet)) =
! 1075: exp(fabs((double) (*((real8 *)
! 1076: (*s_objet_argument_1).objet)))) *
! 1077: gsl_sf_bessel_il_scaled(
! 1078: (int) ((*((integer8 *)
! 1079: (*s_objet_argument_2).objet))),
! 1080: (double) ((*((real8 *)
! 1081: (*s_objet_argument_1).objet))));
! 1082: break;
! 1083: }
! 1084:
! 1085: case 'k' :
! 1086: {
! 1087: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 1088: <= 0) || ((*((integer8 *)
! 1089: (*s_objet_argument_2).objet)) < 0))
! 1090: {
! 1091: (*s_etat_processus).exception =
! 1092: d_ep_resultat_indefini;
! 1093:
! 1094: liberation(s_etat_processus,
! 1095: s_objet_argument_1);
! 1096: liberation(s_etat_processus,
! 1097: s_objet_argument_2);
! 1098: liberation(s_etat_processus,
! 1099: s_objet_argument_3);
! 1100: liberation(s_etat_processus,
! 1101: s_objet_resultat);
! 1102:
! 1103: return;
! 1104: }
! 1105:
! 1106: (*((real8 *) (*s_objet_resultat).objet)) =
! 1107: exp(fabs((double) (*((real8 *)
! 1108: (*s_objet_argument_1).objet)))) *
! 1109: gsl_sf_bessel_kl_scaled(
! 1110: (int) ((*((integer8 *)
! 1111: (*s_objet_argument_2).objet))),
! 1112: (double) ((*((real8 *)
! 1113: (*s_objet_argument_1).objet))));
! 1114: break;
! 1115: }
! 1116: }
! 1117: }
! 1118: else if (((*s_objet_argument_1).type == NOM) ||
! 1119: ((*s_objet_argument_1).type == RPN) ||
! 1120: ((*s_objet_argument_1).type == ALG))
! 1121: {
! 1122: creation_expression = d_vrai;
! 1123: }
! 1124: else
! 1125: {
! 1126: liberation(s_etat_processus, s_objet_argument_1);
! 1127: liberation(s_etat_processus, s_objet_argument_2);
! 1128: liberation(s_etat_processus, s_objet_argument_3);
! 1129:
! 1130: (*s_etat_processus).erreur_execution =
! 1131: d_ex_erreur_type_argument;
! 1132: return;
! 1133: }
! 1134: }
! 1135: else if ((*s_objet_argument_2).type == REL)
! 1136: {
! 1137: if ((*s_objet_argument_1).type == INT)
! 1138: {
! 1139: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1140: == NULL)
! 1141: {
! 1142: (*s_etat_processus).erreur_systeme =
! 1143: d_es_allocation_memoire;
! 1144: return;
! 1145: }
! 1146:
! 1147: switch((*((unsigned char *) (*s_objet_argument_3).objet)))
! 1148: {
! 1149: case 'J' :
! 1150: {
! 1151: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 1152: < 0) || ((*((real8 *)
! 1153: (*s_objet_argument_2).objet)) < 0))
! 1154: {
! 1155: (*s_etat_processus).exception =
! 1156: d_ep_resultat_indefini;
! 1157:
! 1158: liberation(s_etat_processus,
! 1159: s_objet_argument_1);
! 1160: liberation(s_etat_processus,
! 1161: s_objet_argument_2);
! 1162: liberation(s_etat_processus,
! 1163: s_objet_argument_3);
! 1164: liberation(s_etat_processus,
! 1165: s_objet_resultat);
! 1166:
! 1167: return;
! 1168: }
! 1169:
! 1170: (*((real8 *) (*s_objet_resultat).objet)) =
! 1171: gsl_sf_bessel_Jnu((double) ((*((real8 *)
! 1172: (*s_objet_argument_2).objet))),
! 1173: (double) ((*((integer8 *)
! 1174: (*s_objet_argument_1).objet))));
! 1175:
! 1176: break;
! 1177: }
! 1178:
! 1179: case 'Y' :
! 1180: {
! 1181: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 1182: <= 0) || ((*((real8 *)
! 1183: (*s_objet_argument_2).objet)) < 0))
! 1184: {
! 1185: (*s_etat_processus).exception =
! 1186: d_ep_resultat_indefini;
! 1187:
! 1188: liberation(s_etat_processus,
! 1189: s_objet_argument_1);
! 1190: liberation(s_etat_processus,
! 1191: s_objet_argument_2);
! 1192: liberation(s_etat_processus,
! 1193: s_objet_argument_3);
! 1194: liberation(s_etat_processus,
! 1195: s_objet_resultat);
! 1196:
! 1197: return;
! 1198: }
! 1199:
! 1200: (*((real8 *) (*s_objet_resultat).objet)) =
! 1201: gsl_sf_bessel_Ynu((double) ((*((real8 *)
! 1202: (*s_objet_argument_2).objet))),
! 1203: (double) ((*((integer8 *)
! 1204: (*s_objet_argument_1).objet))));
! 1205: break;
! 1206: }
! 1207:
! 1208: case 'I' :
! 1209: {
! 1210: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 1211: < 0) || ((*((real8 *)
! 1212: (*s_objet_argument_2).objet)) < 0))
! 1213: {
! 1214: (*s_etat_processus).exception =
! 1215: d_ep_resultat_indefini;
! 1216:
! 1217: liberation(s_etat_processus,
! 1218: s_objet_argument_1);
! 1219: liberation(s_etat_processus,
! 1220: s_objet_argument_2);
! 1221: liberation(s_etat_processus,
! 1222: s_objet_argument_3);
! 1223: liberation(s_etat_processus,
! 1224: s_objet_resultat);
! 1225:
! 1226: return;
! 1227: }
! 1228:
! 1229: (*((real8 *) (*s_objet_resultat).objet)) =
! 1230: gsl_sf_bessel_Inu((double) ((*((real8 *)
! 1231: (*s_objet_argument_2).objet))),
! 1232: (double) ((*((integer8 *)
! 1233: (*s_objet_argument_1).objet))));
! 1234: break;
! 1235: }
! 1236:
! 1237: case 'K' :
! 1238: {
! 1239: if (((*((integer8 *) (*s_objet_argument_1).objet))
! 1240: <= 0) || ((*((real8 *)
! 1241: (*s_objet_argument_2).objet)) < 0))
! 1242: {
! 1243: (*s_etat_processus).exception =
! 1244: d_ep_resultat_indefini;
! 1245:
! 1246: liberation(s_etat_processus,
! 1247: s_objet_argument_1);
! 1248: liberation(s_etat_processus,
! 1249: s_objet_argument_2);
! 1250: liberation(s_etat_processus,
! 1251: s_objet_argument_3);
! 1252: liberation(s_etat_processus,
! 1253: s_objet_resultat);
! 1254:
! 1255: return;
! 1256: }
! 1257:
! 1258: (*((real8 *) (*s_objet_resultat).objet)) =
! 1259: gsl_sf_bessel_Knu((double) ((*((real8 *)
! 1260: (*s_objet_argument_2).objet))),
! 1261: (double) ((*((integer8 *)
! 1262: (*s_objet_argument_1).objet))));
! 1263: break;
! 1264: }
! 1265:
! 1266: default :
! 1267: {
! 1268: (*s_etat_processus).exception =
! 1269: d_ep_resultat_indefini;
! 1270:
! 1271: liberation(s_etat_processus, s_objet_argument_1);
! 1272: liberation(s_etat_processus, s_objet_argument_2);
! 1273: liberation(s_etat_processus, s_objet_argument_3);
! 1274: liberation(s_etat_processus, s_objet_resultat);
! 1275:
! 1276: return;
! 1277: break;
! 1278: }
! 1279: }
! 1280: }
! 1281: else if ((*s_objet_argument_1).type == REL)
! 1282: {
! 1283: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 1284: == NULL)
! 1285: {
! 1286: (*s_etat_processus).erreur_systeme =
! 1287: d_es_allocation_memoire;
! 1288: return;
! 1289: }
! 1290:
! 1291: switch((*((unsigned char *) (*s_objet_argument_3).objet)))
! 1292: {
! 1293: case 'J' :
! 1294: {
! 1295: if (((*((real8 *) (*s_objet_argument_1).objet))
! 1296: < 0) || ((*((real8 *)
! 1297: (*s_objet_argument_2).objet)) < 0))
! 1298: {
! 1299: (*s_etat_processus).exception =
! 1300: d_ep_resultat_indefini;
! 1301:
! 1302: liberation(s_etat_processus,
! 1303: s_objet_argument_1);
! 1304: liberation(s_etat_processus,
! 1305: s_objet_argument_2);
! 1306: liberation(s_etat_processus,
! 1307: s_objet_argument_3);
! 1308: liberation(s_etat_processus,
! 1309: s_objet_resultat);
! 1310:
! 1311: return;
! 1312: }
! 1313:
! 1314: (*((real8 *) (*s_objet_resultat).objet)) =
! 1315: gsl_sf_bessel_Jnu((double) ((*((real8 *)
! 1316: (*s_objet_argument_2).objet))),
! 1317: (double) ((*((real8 *)
! 1318: (*s_objet_argument_1).objet))));
! 1319: break;
! 1320: }
! 1321:
! 1322: case 'Y' :
! 1323: {
! 1324: if (((*((real8 *) (*s_objet_argument_1).objet))
! 1325: <= 0) || ((*((real8 *)
! 1326: (*s_objet_argument_2).objet)) < 0))
! 1327: {
! 1328: (*s_etat_processus).exception =
! 1329: d_ep_resultat_indefini;
! 1330:
! 1331: liberation(s_etat_processus,
! 1332: s_objet_argument_1);
! 1333: liberation(s_etat_processus,
! 1334: s_objet_argument_2);
! 1335: liberation(s_etat_processus,
! 1336: s_objet_argument_3);
! 1337: liberation(s_etat_processus,
! 1338: s_objet_resultat);
! 1339:
! 1340: return;
! 1341: }
! 1342:
! 1343: (*((real8 *) (*s_objet_resultat).objet)) =
! 1344: gsl_sf_bessel_Yn((double) ((*((real8 *)
! 1345: (*s_objet_argument_2).objet))),
! 1346: (double) ((*((real8 *)
! 1347: (*s_objet_argument_1).objet))));
! 1348: break;
! 1349: }
! 1350:
! 1351: case 'I' :
! 1352: {
! 1353: if (((*((real8 *) (*s_objet_argument_1).objet))
! 1354: < 0) || ((*((real8 *)
! 1355: (*s_objet_argument_2).objet)) < 0))
! 1356: {
! 1357: (*s_etat_processus).exception =
! 1358: d_ep_resultat_indefini;
! 1359:
! 1360: liberation(s_etat_processus,
! 1361: s_objet_argument_1);
! 1362: liberation(s_etat_processus,
! 1363: s_objet_argument_2);
! 1364: liberation(s_etat_processus,
! 1365: s_objet_argument_3);
! 1366: liberation(s_etat_processus,
! 1367: s_objet_resultat);
! 1368:
! 1369: return;
! 1370: }
! 1371:
! 1372: (*((real8 *) (*s_objet_resultat).objet)) =
! 1373: gsl_sf_bessel_In((double) ((*((real8 *)
! 1374: (*s_objet_argument_2).objet))),
! 1375: (double) ((*((real8 *)
! 1376: (*s_objet_argument_1).objet))));
! 1377: break;
! 1378: }
! 1379:
! 1380: case 'K' :
! 1381: {
! 1382: if (((*((real8 *) (*s_objet_argument_1).objet))
! 1383: <= 0) || ((*((real8 *)
! 1384: (*s_objet_argument_2).objet)) < 0))
! 1385: {
! 1386: (*s_etat_processus).exception =
! 1387: d_ep_resultat_indefini;
! 1388:
! 1389: liberation(s_etat_processus,
! 1390: s_objet_argument_1);
! 1391: liberation(s_etat_processus,
! 1392: s_objet_argument_2);
! 1393: liberation(s_etat_processus,
! 1394: s_objet_argument_3);
! 1395: liberation(s_etat_processus,
! 1396: s_objet_resultat);
! 1397:
! 1398: return;
! 1399: }
! 1400:
! 1401: (*((real8 *) (*s_objet_resultat).objet)) =
! 1402: gsl_sf_bessel_Kn((double) ((*((real8 *)
! 1403: (*s_objet_argument_2).objet))),
! 1404: (double) ((*((real8 *)
! 1405: (*s_objet_argument_1).objet))));
! 1406: break;
! 1407: }
! 1408:
! 1409: default :
! 1410: {
! 1411: (*s_etat_processus).exception =
! 1412: d_ep_resultat_indefini;
! 1413:
! 1414: liberation(s_etat_processus, s_objet_argument_1);
! 1415: liberation(s_etat_processus, s_objet_argument_2);
! 1416: liberation(s_etat_processus, s_objet_argument_3);
! 1417: liberation(s_etat_processus, s_objet_resultat);
! 1418:
! 1419: return;
! 1420: break;
! 1421: }
! 1422: }
! 1423: }
! 1424: else
! 1425: {
! 1426: liberation(s_etat_processus, s_objet_argument_1);
! 1427: liberation(s_etat_processus, s_objet_argument_2);
! 1428: liberation(s_etat_processus, s_objet_argument_3);
! 1429:
! 1430: (*s_etat_processus).erreur_execution =
! 1431: d_ex_erreur_type_argument;
! 1432: return;
! 1433: }
! 1434: }
! 1435: else if (((*s_objet_argument_2).type == NOM) ||
! 1436: ((*s_objet_argument_2).type == RPN) ||
! 1437: ((*s_objet_argument_2).type == ALG))
! 1438: {
! 1439: creation_expression = d_vrai;
! 1440: }
! 1441: else
! 1442: {
! 1443: liberation(s_etat_processus, s_objet_argument_1);
! 1444: liberation(s_etat_processus, s_objet_argument_2);
! 1445: liberation(s_etat_processus, s_objet_argument_3);
! 1446:
! 1447: (*s_etat_processus).erreur_execution =
! 1448: d_ex_erreur_type_argument;
! 1449: return;
! 1450: }
! 1451: }
! 1452: else
! 1453: {
! 1454: liberation(s_etat_processus, s_objet_argument_1);
! 1455: liberation(s_etat_processus, s_objet_argument_2);
! 1456: liberation(s_etat_processus, s_objet_argument_3);
! 1457:
! 1458: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 1459: return;
! 1460: }
! 1461: }
! 1462: else if (((*s_objet_argument_3).type == NOM) ||
! 1463: ((*s_objet_argument_3).type == RPN) ||
! 1464: ((*s_objet_argument_3).type == ALG))
! 1465: {
! 1466: creation_expression = d_vrai;
! 1467: }
! 1468: else
! 1469: {
! 1470: liberation(s_etat_processus, s_objet_argument_1);
! 1471: liberation(s_etat_processus, s_objet_argument_2);
! 1472: liberation(s_etat_processus, s_objet_argument_3);
! 1473:
! 1474: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1475: return;
! 1476: }
! 1477:
! 1478: if (creation_expression == d_vrai)
! 1479: {
! 1480: if ((s_copie_argument_1 = copie_objet(s_etat_processus,
! 1481: s_objet_argument_1, 'N')) == NULL)
! 1482: {
! 1483: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1484: return;
! 1485: }
! 1486:
! 1487: if ((s_copie_argument_2 = copie_objet(s_etat_processus,
! 1488: s_objet_argument_2, 'N')) == NULL)
! 1489: {
! 1490: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1491: return;
! 1492: }
! 1493:
! 1494: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
! 1495: s_objet_argument_3, 'N')) == NULL)
! 1496: {
! 1497: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1498: return;
! 1499: }
! 1500:
! 1501: if (((*s_copie_argument_1).type == RPN) ||
! 1502: ((*s_copie_argument_2).type == RPN) ||
! 1503: ((*s_copie_argument_3).type == RPN))
! 1504: {
! 1505: if ((s_objet_resultat = allocation(s_etat_processus, RPN))
! 1506: == NULL)
! 1507: {
! 1508: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1509: return;
! 1510: }
! 1511: }
! 1512: else
! 1513: {
! 1514: if ((s_objet_resultat = allocation(s_etat_processus, ALG))
! 1515: == NULL)
! 1516: {
! 1517: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1518: return;
! 1519: }
! 1520: }
! 1521:
! 1522: if (((*s_objet_resultat).objet =
! 1523: allocation_maillon(s_etat_processus)) == NULL)
! 1524: {
! 1525: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1526: return;
! 1527: }
! 1528:
! 1529: l_element_courant = (*s_objet_resultat).objet;
! 1530:
! 1531: if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
! 1532: == NULL)
! 1533: {
! 1534: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1535: return;
! 1536: }
! 1537:
! 1538: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1539: .nombre_arguments = 0;
! 1540: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1541: .fonction = instruction_vers_niveau_superieur;
! 1542:
! 1543: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1544: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1545: {
! 1546: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1547: return;
! 1548: }
! 1549:
! 1550: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1551: .nom_fonction, "<<");
! 1552:
! 1553: if (((*s_copie_argument_3).type == ALG) ||
! 1554: ((*s_copie_argument_3).type == RPN))
! 1555: {
! 1556:
! 1557: l_element_atome = (struct_liste_chainee *)
! 1558: (*s_copie_argument_3).objet;
! 1559:
! 1560: i = 0;
! 1561:
! 1562: while(l_element_atome != NULL)
! 1563: {
! 1564: i++;
! 1565: l_element_atome = (*l_element_atome).suivant;
! 1566: }
! 1567:
! 1568: if (i < 3)
! 1569: {
! 1570: if (((*l_element_courant).suivant =
! 1571: allocation_maillon(s_etat_processus)) == NULL)
! 1572: {
! 1573: (*s_etat_processus).erreur_systeme =
! 1574: d_es_allocation_memoire;
! 1575: return;
! 1576: }
! 1577:
! 1578: l_element_courant = (*l_element_courant).suivant;
! 1579: (*l_element_courant).donnee = s_copie_argument_3;
! 1580: }
! 1581: else
! 1582: {
! 1583: (*l_element_courant).suivant = (*((struct_liste_chainee *)
! 1584: (*s_copie_argument_3).objet)).suivant;
! 1585:
! 1586: l_element_precedent = NULL;
! 1587: l_element_courant = (*l_element_courant).suivant;
! 1588:
! 1589: liberation(s_etat_processus,
! 1590: (*((struct_liste_chainee *) (*s_copie_argument_3)
! 1591: .objet)).donnee);
! 1592: free((*s_copie_argument_3).objet);
! 1593: free(s_copie_argument_3);
! 1594:
! 1595: while((*l_element_courant).suivant != NULL)
! 1596: {
! 1597: l_element_precedent = l_element_courant;
! 1598: l_element_courant = (*l_element_courant).suivant;
! 1599: }
! 1600:
! 1601: liberation(s_etat_processus, (*l_element_courant).donnee);
! 1602: free(l_element_courant);
! 1603:
! 1604: l_element_courant = l_element_precedent;
! 1605: }
! 1606: }
! 1607: else
! 1608: {
! 1609: if (((*l_element_courant).suivant =
! 1610: allocation_maillon(s_etat_processus)) == NULL)
! 1611: {
! 1612: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1613: return;
! 1614: }
! 1615:
! 1616: l_element_courant = (*l_element_courant).suivant;
! 1617: (*l_element_courant).donnee = s_copie_argument_3;
! 1618: }
! 1619:
! 1620: if (((*s_copie_argument_2).type == ALG) ||
! 1621: ((*s_copie_argument_2).type == RPN))
! 1622: {
! 1623: l_element_atome = (struct_liste_chainee *)
! 1624: (*s_copie_argument_2).objet;
! 1625:
! 1626: i = 0;
! 1627:
! 1628: while(l_element_atome != NULL)
! 1629: {
! 1630: i++;
! 1631: l_element_atome = (*l_element_atome).suivant;
! 1632: }
! 1633:
! 1634: if (i < 3)
! 1635: {
! 1636: if (((*l_element_courant).suivant =
! 1637: allocation_maillon(s_etat_processus)) == NULL)
! 1638: {
! 1639: (*s_etat_processus).erreur_systeme =
! 1640: d_es_allocation_memoire;
! 1641: return;
! 1642: }
! 1643:
! 1644: l_element_courant = (*l_element_courant).suivant;
! 1645: (*l_element_courant).donnee = s_copie_argument_2;
! 1646: }
! 1647: else
! 1648: {
! 1649: (*l_element_courant).suivant = (*((struct_liste_chainee *)
! 1650: (*s_copie_argument_2).objet)).suivant;
! 1651:
! 1652: l_element_courant = (*l_element_courant).suivant;
! 1653: l_element_precedent = NULL;
! 1654:
! 1655: liberation(s_etat_processus,
! 1656: (*((struct_liste_chainee *) (*s_copie_argument_2)
! 1657: .objet)).donnee);
! 1658: free((*s_copie_argument_2).objet);
! 1659: free(s_copie_argument_2);
! 1660:
! 1661: while((*l_element_courant).suivant != NULL)
! 1662: {
! 1663: l_element_precedent = l_element_courant;
! 1664: l_element_courant = (*l_element_courant).suivant;
! 1665: }
! 1666:
! 1667: liberation(s_etat_processus, (*l_element_courant).donnee);
! 1668: free(l_element_courant);
! 1669:
! 1670: l_element_courant = l_element_precedent;
! 1671: }
! 1672: }
! 1673: else
! 1674: {
! 1675: if (((*l_element_courant).suivant =
! 1676: allocation_maillon(s_etat_processus)) == NULL)
! 1677: {
! 1678: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1679: return;
! 1680: }
! 1681:
! 1682: l_element_courant = (*l_element_courant).suivant;
! 1683: (*l_element_courant).donnee = s_copie_argument_2;
! 1684: }
! 1685:
! 1686: if (((*s_copie_argument_1).type == ALG) ||
! 1687: ((*s_copie_argument_1).type == RPN))
! 1688: {
! 1689: l_element_atome = (struct_liste_chainee *)
! 1690: (*s_copie_argument_1).objet;
! 1691:
! 1692: i = 0;
! 1693:
! 1694: while(l_element_atome != NULL)
! 1695: {
! 1696: i++;
! 1697: l_element_atome = (*l_element_atome).suivant;
! 1698: }
! 1699:
! 1700: if (i < 3)
! 1701: {
! 1702: if (((*l_element_courant).suivant =
! 1703: allocation_maillon(s_etat_processus)) == NULL)
! 1704: {
! 1705: (*s_etat_processus).erreur_systeme =
! 1706: d_es_allocation_memoire;
! 1707: return;
! 1708: }
! 1709:
! 1710: l_element_courant = (*l_element_courant).suivant;
! 1711: (*l_element_courant).donnee = s_copie_argument_1;
! 1712: }
! 1713: else
! 1714: {
! 1715: (*l_element_courant).suivant = (*((struct_liste_chainee *)
! 1716: (*s_copie_argument_1).objet)).suivant;
! 1717:
! 1718: l_element_courant = (*l_element_courant).suivant;
! 1719: l_element_precedent = NULL;
! 1720:
! 1721: liberation(s_etat_processus,
! 1722: (*((struct_liste_chainee *) (*s_copie_argument_1)
! 1723: .objet)).donnee);
! 1724: free((*s_copie_argument_1).objet);
! 1725: free(s_copie_argument_1);
! 1726:
! 1727: while((*l_element_courant).suivant != NULL)
! 1728: {
! 1729: l_element_precedent = l_element_courant;
! 1730: l_element_courant = (*l_element_courant).suivant;
! 1731: }
! 1732:
! 1733: liberation(s_etat_processus, (*l_element_courant).donnee);
! 1734: free(l_element_courant);
! 1735:
! 1736: l_element_courant = l_element_precedent;
! 1737: }
! 1738: }
! 1739: else
! 1740: {
! 1741: if (((*l_element_courant).suivant =
! 1742: allocation_maillon(s_etat_processus)) == NULL)
! 1743: {
! 1744: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1745: return;
! 1746: }
! 1747:
! 1748: l_element_courant = (*l_element_courant).suivant;
! 1749: (*l_element_courant).donnee = s_copie_argument_1;
! 1750: }
! 1751:
! 1752: if (((*l_element_courant).suivant =
! 1753: allocation_maillon(s_etat_processus)) == NULL)
! 1754: {
! 1755: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1756: return;
! 1757: }
! 1758:
! 1759: l_element_courant = (*l_element_courant).suivant;
! 1760:
! 1761: if (((*l_element_courant).donnee =
! 1762: allocation(s_etat_processus, FCT)) == NULL)
! 1763: {
! 1764: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1765: return;
! 1766: }
! 1767:
! 1768: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1769: .nombre_arguments = 3;
! 1770: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1771: .fonction = instruction_bessel;
! 1772:
! 1773: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1774: .nom_fonction = malloc(7 * sizeof(unsigned char))) == NULL)
! 1775: {
! 1776: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1777: return;
! 1778: }
! 1779:
! 1780: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1781: .nom_fonction, "BESSEL");
! 1782:
! 1783: if (((*l_element_courant).suivant =
! 1784: allocation_maillon(s_etat_processus)) == NULL)
! 1785: {
! 1786: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1787: return;
! 1788: }
! 1789:
! 1790: l_element_courant = (*l_element_courant).suivant;
! 1791:
! 1792: if (((*l_element_courant).donnee = (struct_objet *)
! 1793: allocation(s_etat_processus, FCT)) == NULL)
! 1794: {
! 1795: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1796: return;
! 1797: }
! 1798:
! 1799: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1800: .nombre_arguments = 0;
! 1801: (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1802: .fonction = instruction_vers_niveau_inferieur;
! 1803:
! 1804: if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1805: .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
! 1806: {
! 1807: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1808: return;
! 1809: }
! 1810:
! 1811: strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
! 1812: .nom_fonction, ">>");
! 1813:
! 1814: (*l_element_courant).suivant = NULL;
! 1815: }
! 1816:
! 1817: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1818: s_objet_resultat) == d_erreur)
! 1819: {
! 1820: return;
! 1821: }
! 1822:
! 1823: liberation(s_etat_processus, s_objet_argument_1);
! 1824: liberation(s_etat_processus, s_objet_argument_2);
! 1825: liberation(s_etat_processus, s_objet_argument_3);
! 1826:
! 1827: return;
! 1828: }
! 1829:
! 1830: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_b1.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src