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