![]() ![]() | ![]() |
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 'clmf' 29: ================================================================================ 30: Entrées : structure processus 31: -------------------------------------------------------------------------------- 32: Sorties : 33: -------------------------------------------------------------------------------- 34: Effets de bord : néant 35: ================================================================================ 36: */ 37: 38: void 39: instruction_clmf(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 CLMF "); 46: 47: if ((*s_etat_processus).langue == 'F') 48: { 49: printf("(affiche la pile opérationnelle)\n\n"); 50: printf(" Aucun argument\n"); 51: } 52: else 53: { 54: printf("(print stack)\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: affichage_pile(s_etat_processus, (*s_etat_processus).l_base_pile, 1); 67: 68: return; 69: } 70: 71: 72: /* 73: ================================================================================ 74: Fonction 'cont' 75: ================================================================================ 76: Entrées : 77: -------------------------------------------------------------------------------- 78: Sorties : 79: -------------------------------------------------------------------------------- 80: Effets de bord : néant 81: ================================================================================ 82: */ 83: 84: void 85: instruction_cont(struct_processus *s_etat_processus) 86: { 87: (*s_etat_processus).erreur_execution = d_ex; 88: 89: if ((*s_etat_processus).affichage_arguments == 'Y') 90: { 91: printf("\n CONT "); 92: 93: if ((*s_etat_processus).langue == 'F') 94: { 95: printf("(continue un programme arrêté par HALT)\n\n"); 96: printf(" Aucun argument\n"); 97: } 98: else 99: { 100: printf("(continue a program stopped by HALT)\n\n"); 101: printf(" No argument\n"); 102: } 103: 104: return; 105: } 106: else if ((*s_etat_processus).test_instruction == 'Y') 107: { 108: (*s_etat_processus).nombre_arguments = -1; 109: return; 110: } 111: 112: (*s_etat_processus).debug_programme = d_faux; 113: (*s_etat_processus).execution_pas_suivant = d_vrai; 114: 115: return; 116: } 117: 118: 119: /* 120: ================================================================================ 121: Fonction 'cnrm' 122: ================================================================================ 123: Entrées : pointeur sur une structure struct_processus 124: -------------------------------------------------------------------------------- 125: Sorties : 126: -------------------------------------------------------------------------------- 127: Effets de bord : néant 128: ================================================================================ 129: */ 130: 131: void 132: instruction_cnrm(struct_processus *s_etat_processus) 133: { 134: integer8 cumul_entier; 135: integer8 entier_courant; 136: integer8 tampon; 137: 138: logical1 depassement; 139: logical1 erreur_memoire; 140: 141: real8 cumul_reel; 142: 143: struct_objet *s_objet_argument; 144: struct_objet *s_objet_resultat; 145: 146: unsigned long i; 147: unsigned long j; 148: 149: void *accumulateur; 150: 151: (*s_etat_processus).erreur_execution = d_ex; 152: 153: if ((*s_etat_processus).affichage_arguments == 'Y') 154: { 155: printf("\n CNRM "); 156: 157: if ((*s_etat_processus).langue == 'F') 158: { 159: printf("(norme de colonne)\n\n"); 160: } 161: else 162: { 163: printf("(column norm)\n\n"); 164: } 165: 166: printf(" 1: %s, %s\n", d_VIN, d_MIN); 167: printf("-> 1: %s, %s\n\n", d_INT, d_REL); 168: 169: printf(" 1: %s, %s, %s, %s\n", d_VRL, d_VCX, d_MRL, d_MCX); 170: printf("-> 1: %s\n", d_REL); 171: 172: return; 173: } 174: else if ((*s_etat_processus).test_instruction == 'Y') 175: { 176: (*s_etat_processus).nombre_arguments = -1; 177: return; 178: } 179: 180: if (test_cfsf(s_etat_processus, 31) == d_vrai) 181: { 182: if (empilement_pile_last(s_etat_processus, 1) == d_erreur) 183: { 184: return; 185: } 186: } 187: 188: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 189: &s_objet_argument) == d_erreur) 190: { 191: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 192: return; 193: } 194: 195: /* 196: -------------------------------------------------------------------------------- 197: Traitement des vecteurs 198: -------------------------------------------------------------------------------- 199: */ 200: 201: if ((*s_objet_argument).type == VIN) 202: { 203: cumul_entier = 0; 204: depassement = d_faux; 205: 206: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille; 207: i++) 208: { 209: entier_courant = abs(((integer8 *) (*((struct_vecteur *) 210: (*s_objet_argument).objet)).tableau)[i]); 211: 212: if (depassement_addition(&cumul_entier, &entier_courant, 213: &tampon) == d_erreur) 214: { 215: depassement = d_vrai; 216: break; 217: } 218: 219: cumul_entier = tampon; 220: } 221: 222: if (depassement == d_faux) 223: { 224: if ((s_objet_resultat = allocation(s_etat_processus, INT)) 225: == NULL) 226: { 227: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 228: return; 229: } 230: 231: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier; 232: } 233: else 234: { 235: cumul_reel = 0; 236: 237: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)) 238: .taille; i++) 239: { 240: cumul_reel += (real8) abs(((integer8 *) (*((struct_vecteur *) 241: (*s_objet_argument).objet)).tableau)[i]); 242: } 243: 244: if ((s_objet_resultat = allocation(s_etat_processus, REL)) 245: == NULL) 246: { 247: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 248: return; 249: } 250: 251: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel; 252: } 253: } 254: else if ((*s_objet_argument).type == VRL) 255: { 256: if ((s_objet_resultat = allocation(s_etat_processus, REL)) 257: == NULL) 258: { 259: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 260: return; 261: } 262: 263: if ((accumulateur = malloc((*((struct_vecteur *) 264: (*s_objet_argument).objet)).taille * sizeof(real8))) == NULL) 265: { 266: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 267: return; 268: } 269: 270: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille; 271: i++) 272: { 273: ((real8 *) accumulateur)[i] = 274: fabs(((real8 *) (*((struct_vecteur *) 275: (*s_objet_argument).objet)).tableau)[i]); 276: } 277: 278: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel( 279: accumulateur, &((*((struct_vecteur *) (*s_objet_argument) 280: .objet)).taille), &erreur_memoire); 281: 282: if (erreur_memoire == d_vrai) 283: { 284: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 285: return; 286: } 287: 288: free(accumulateur); 289: } 290: else if ((*s_objet_argument).type == VCX) 291: { 292: if ((s_objet_resultat = allocation(s_etat_processus, REL)) 293: == NULL) 294: { 295: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 296: return; 297: } 298: 299: if ((accumulateur = malloc((*((struct_vecteur *) 300: (*s_objet_argument).objet)).taille * sizeof(real8))) == NULL) 301: { 302: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 303: return; 304: } 305: 306: for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet)).taille; 307: i++) 308: { 309: f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *) 310: (*s_objet_argument).objet)).tableau)[i]), 311: &(((real8 *) accumulateur)[i])); 312: } 313: 314: (*((real8 *) (*s_objet_resultat).objet)) = sommation_vecteur_reel( 315: accumulateur, &((*((struct_vecteur *) (*s_objet_argument) 316: .objet)).taille), &erreur_memoire); 317: 318: if (erreur_memoire == d_vrai) 319: { 320: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 321: return; 322: } 323: 324: free(accumulateur); 325: } 326: 327: /* 328: -------------------------------------------------------------------------------- 329: Traitement des matrices 330: -------------------------------------------------------------------------------- 331: */ 332: 333: else if ((*s_objet_argument).type == MIN) 334: { 335: if ((s_objet_resultat = allocation(s_etat_processus, INT)) 336: == NULL) 337: { 338: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 339: return; 340: } 341: 342: depassement = d_faux; 343: cumul_entier = 0; 344: 345: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) 346: .nombre_lignes; i++) 347: { 348: entier_courant = abs(((integer8 **) 349: (*((struct_matrice *) (*s_objet_argument).objet)) 350: .tableau)[i][0]); 351: 352: if (depassement_addition(&cumul_entier, &entier_courant, 353: &tampon) == d_erreur) 354: { 355: depassement = d_vrai; 356: break; 357: } 358: 359: cumul_entier = tampon; 360: } 361: 362: if (depassement == d_faux) 363: { 364: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier; 365: 366: for(j = 1; j < (*((struct_matrice *) (*s_objet_argument).objet)) 367: .nombre_colonnes; j++) 368: { 369: cumul_entier = 0; 370: 371: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) 372: .nombre_lignes; i++) 373: { 374: entier_courant = abs(((integer8 **) (*((struct_matrice *) 375: (*s_objet_argument).objet)).tableau)[i][j]); 376: 377: if (depassement_addition(&cumul_entier, &entier_courant, 378: &tampon) == d_erreur) 379: { 380: depassement = d_vrai; 381: break; 382: } 383: 384: cumul_entier = tampon; 385: } 386: 387: if (depassement == d_vrai) 388: { 389: break; 390: } 391: 392: if (cumul_entier > (*((integer8 *) (*s_objet_resultat).objet))) 393: { 394: (*((integer8 *) (*s_objet_resultat).objet)) = cumul_entier; 395: } 396: } 397: } 398: 399: if (depassement == d_vrai) 400: { 401: /* 402: * Dépassement : il faut refaire le calcul en real*8... 403: */ 404: 405: free((*s_objet_resultat).objet); 406: (*s_objet_resultat).type = REL; 407: 408: if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL) 409: { 410: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 411: return; 412: } 413: 414: if ((accumulateur = malloc((*((struct_matrice *) 415: (*s_objet_argument).objet)).nombre_lignes * sizeof(real8))) 416: == NULL) 417: { 418: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 419: return; 420: } 421: 422: (*((real8 *) (*s_objet_resultat).objet)) = 0; 423: 424: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet)) 425: .nombre_colonnes; j++) 426: { 427: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) 428: .nombre_lignes; i++) 429: { 430: ((real8 *) accumulateur)[i] = fabs((real8) ((integer8 **) 431: (*((struct_matrice *) 432: (*s_objet_argument).objet)).tableau)[i][j]); 433: } 434: 435: cumul_reel = sommation_vecteur_reel(accumulateur, 436: &((*((struct_matrice *) (*s_objet_argument).objet)) 437: .nombre_lignes), &erreur_memoire); 438: 439: if (erreur_memoire == d_vrai) 440: { 441: (*s_etat_processus).erreur_systeme = 442: d_es_allocation_memoire; 443: return; 444: } 445: 446: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet))) 447: { 448: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel; 449: } 450: } 451: 452: free(accumulateur); 453: } 454: } 455: else if ((*s_objet_argument).type == MRL) 456: { 457: if ((s_objet_resultat = allocation(s_etat_processus, REL)) 458: == NULL) 459: { 460: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 461: return; 462: } 463: 464: if ((accumulateur = malloc((*((struct_matrice *) 465: (*s_objet_argument).objet)).nombre_lignes * sizeof(real8))) 466: == NULL) 467: { 468: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 469: return; 470: } 471: 472: (*((real8 *) (*s_objet_resultat).objet)) = 0; 473: 474: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet)) 475: .nombre_colonnes; j++) 476: { 477: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) 478: .nombre_lignes; i++) 479: { 480: ((real8 *) accumulateur)[i] = fabs(((real8 **) 481: (*((struct_matrice *) 482: (*s_objet_argument).objet)).tableau)[i][j]); 483: } 484: 485: cumul_reel = sommation_vecteur_reel(accumulateur, 486: &((*((struct_matrice *) (*s_objet_argument).objet)) 487: .nombre_lignes), &erreur_memoire); 488: 489: if (erreur_memoire == d_vrai) 490: { 491: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 492: return; 493: } 494: 495: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet))) 496: { 497: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel; 498: } 499: } 500: 501: free(accumulateur); 502: } 503: else if ((*s_objet_argument).type == MCX) 504: { 505: if ((s_objet_resultat = allocation(s_etat_processus, REL)) 506: == NULL) 507: { 508: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 509: return; 510: } 511: 512: if ((accumulateur = malloc((*((struct_matrice *) 513: (*s_objet_argument).objet)).nombre_lignes * sizeof(real8))) 514: == NULL) 515: { 516: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 517: return; 518: } 519: 520: (*((real8 *) (*s_objet_resultat).objet)) = 0; 521: 522: for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet)) 523: .nombre_colonnes; j++) 524: { 525: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet)) 526: .nombre_lignes; i++) 527: { 528: f77absc_(&(((struct_complexe16 **) (*((struct_matrice *) 529: (*s_objet_argument).objet)).tableau)[i][j]), 530: &(((real8 *) accumulateur)[i])); 531: } 532: 533: cumul_reel = sommation_vecteur_reel(accumulateur, 534: &((*((struct_matrice *) (*s_objet_argument).objet)) 535: .nombre_lignes), &erreur_memoire); 536: 537: if (erreur_memoire == d_vrai) 538: { 539: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 540: return; 541: } 542: 543: if (cumul_reel > (*((real8 *) (*s_objet_resultat).objet))) 544: { 545: (*((real8 *) (*s_objet_resultat).objet)) = cumul_reel; 546: } 547: } 548: 549: free(accumulateur); 550: } 551: 552: /* 553: -------------------------------------------------------------------------------- 554: Traitement impossible du fait du type de l'argument 555: -------------------------------------------------------------------------------- 556: */ 557: 558: else 559: { 560: liberation(s_etat_processus, s_objet_argument); 561: 562: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 563: return; 564: } 565: 566: liberation(s_etat_processus, s_objet_argument); 567: 568: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 569: s_objet_resultat) == d_erreur) 570: { 571: return; 572: } 573: 574: return; 575: } 576: 577: 578: /* 579: ================================================================================ 580: Fonction 'chr' 581: ================================================================================ 582: Entrées : structure processus 583: -------------------------------------------------------------------------------- 584: Sorties : 585: -------------------------------------------------------------------------------- 586: Effets de bord : néant 587: ================================================================================ 588: */ 589: 590: void 591: instruction_chr(struct_processus *s_etat_processus) 592: { 593: struct_objet *s_objet_argument; 594: struct_objet *s_objet_resultat; 595: 596: (*s_etat_processus).erreur_execution = d_ex; 597: 598: if ((*s_etat_processus).affichage_arguments == 'Y') 599: { 600: printf("\n CHR "); 601: 602: if ((*s_etat_processus).langue == 'F') 603: { 604: printf("(conversion d'un entier en caractère)\n\n"); 605: } 606: else 607: { 608: printf("(integer to character conversion)\n\n"); 609: } 610: 611: printf(" 1: %s\n", d_INT); 612: printf("-> 1: %s\n", d_CHN); 613: 614: return; 615: } 616: else if ((*s_etat_processus).test_instruction == 'Y') 617: { 618: (*s_etat_processus).nombre_arguments = -1; 619: return; 620: } 621: 622: if (test_cfsf(s_etat_processus, 31) == d_vrai) 623: { 624: if (empilement_pile_last(s_etat_processus, 1) == d_erreur) 625: { 626: return; 627: } 628: } 629: 630: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 631: &s_objet_argument) == d_erreur) 632: { 633: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 634: return; 635: } 636: 637: /* 638: -------------------------------------------------------------------------------- 639: Entier 640: -------------------------------------------------------------------------------- 641: */ 642: 643: if ((*s_objet_argument).type == INT) 644: { 645: if ((*((integer8 *) (*s_objet_argument).objet)) != 646: (unsigned char) (*((integer8 *) (*s_objet_argument).objet))) 647: { 648: liberation(s_etat_processus, s_objet_argument); 649: 650: (*s_etat_processus).erreur_execution = d_ex_argument_invalide; 651: return; 652: } 653: 654: if (isprint((unsigned char) (*((integer8 *) (*s_objet_argument).objet))) 655: != 0) 656: { 657: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL) 658: { 659: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 660: return; 661: } 662: 663: if (((*s_objet_resultat).objet = malloc(2 * sizeof(unsigned char))) 664: == NULL) 665: { 666: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 667: return; 668: } 669: 670: ((unsigned char *) (*s_objet_resultat).objet)[0] = (*((integer8 *) 671: (*s_objet_argument).objet)); 672: ((unsigned char *) (*s_objet_resultat).objet)[1] = 673: d_code_fin_chaine; 674: } 675: else 676: { 677: liberation(s_etat_processus, s_objet_argument); 678: 679: (*s_etat_processus).erreur_execution = d_ex_argument_invalide; 680: return; 681: } 682: } 683: 684: /* 685: -------------------------------------------------------------------------------- 686: Type invalide 687: -------------------------------------------------------------------------------- 688: */ 689: 690: else 691: { 692: liberation(s_etat_processus, s_objet_argument); 693: 694: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 695: return; 696: } 697: 698: liberation(s_etat_processus, s_objet_argument); 699: 700: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 701: s_objet_resultat) == d_erreur) 702: { 703: return; 704: } 705: 706: return; 707: } 708: 709: 710: /* 711: ================================================================================ 712: Fonction 'cr' 713: ================================================================================ 714: Entrées : structure processus 715: -------------------------------------------------------------------------------- 716: Sorties : 717: -------------------------------------------------------------------------------- 718: Effets de bord : néant 719: ================================================================================ 720: */ 721: 722: void 723: instruction_cr(struct_processus *s_etat_processus) 724: { 725: struct_objet s_objet; 726: 727: unsigned char commande[] = "\\\\par"; 728: 729: (*s_etat_processus).erreur_execution = d_ex; 730: 731: if ((*s_etat_processus).affichage_arguments == 'Y') 732: { 733: printf("\n CR "); 734: 735: if ((*s_etat_processus).langue == 'F') 736: { 737: printf("(retour à la ligne dans la sortie imprimée)\n\n"); 738: printf(" Aucun argument\n"); 739: } 740: else 741: { 742: printf("(carriage return in the printer output)\n\n"); 743: printf(" No argument\n"); 744: } 745: 746: return; 747: } 748: else if ((*s_etat_processus).test_instruction == 'Y') 749: { 750: (*s_etat_processus).nombre_arguments = -1; 751: return; 752: } 753: 754: if (test_cfsf(s_etat_processus, 31) == d_vrai) 755: { 756: if (empilement_pile_last(s_etat_processus, 0) == d_erreur) 757: { 758: return; 759: } 760: } 761: 762: s_objet.objet = commande; 763: s_objet.type = CHN; 764: 765: formateur_tex(s_etat_processus, &s_objet, 'N'); 766: return; 767: } 768: 769: 770: /* 771: ================================================================================ 772: Fonction 'centr' 773: ================================================================================ 774: Entrées : pointeur sur une structure struct_processus 775: -------------------------------------------------------------------------------- 776: Sorties : 777: -------------------------------------------------------------------------------- 778: Effets de bord : néant 779: ================================================================================ 780: */ 781: 782: void 783: instruction_centr(struct_processus *s_etat_processus) 784: { 785: real8 x_max; 786: real8 x_min; 787: real8 y_max; 788: real8 y_min; 789: 790: struct_objet *s_objet_argument; 791: 792: (*s_etat_processus).erreur_execution = d_ex; 793: 794: 795: if ((*s_etat_processus).affichage_arguments == 'Y') 796: { 797: printf("\n CENTR "); 798: 799: if ((*s_etat_processus).langue == 'F') 800: { 801: printf("(centre des graphiques)\n\n"); 802: } 803: else 804: { 805: printf("(center of the graphics)\n\n"); 806: } 807: 808: printf(" 1: %s\n", d_CPL); 809: 810: return; 811: } 812: else if ((*s_etat_processus).test_instruction == 'Y') 813: { 814: (*s_etat_processus).nombre_arguments = -1; 815: return; 816: } 817: 818: if (test_cfsf(s_etat_processus, 31) == d_vrai) 819: { 820: if (empilement_pile_last(s_etat_processus, 1) == d_erreur) 821: { 822: return; 823: } 824: } 825: 826: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 827: &s_objet_argument) == d_erreur) 828: { 829: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 830: return; 831: } 832: 833: if ((*s_objet_argument).type == CPL) 834: { 835: if ((*s_etat_processus).systeme_axes == 0) 836: { 837: x_min = (*s_etat_processus).x_min; 838: x_max = (*s_etat_processus).x_max; 839: 840: y_min = (*s_etat_processus).y_min; 841: y_max = (*s_etat_processus).y_max; 842: 843: (*s_etat_processus).x_min = (*((complex16 *) 844: (*s_objet_argument).objet)) 845: .partie_reelle - ((x_max - x_min) / ((double) 2)); 846: (*s_etat_processus).x_max = (*((complex16 *) 847: (*s_objet_argument).objet)) 848: .partie_reelle + ((x_max - x_min) / ((double) 2)); 849: 850: (*s_etat_processus).y_min = (*((complex16 *) 851: (*s_objet_argument).objet)) 852: .partie_imaginaire - ((y_max - y_min) / ((double) 2)); 853: (*s_etat_processus).y_max = (*((complex16 *) 854: (*s_objet_argument).objet)) 855: .partie_imaginaire + ((y_max - y_min) / ((double) 2)); 856: } 857: else 858: { 859: x_min = (*s_etat_processus).x2_min; 860: x_max = (*s_etat_processus).x2_max; 861: 862: y_min = (*s_etat_processus).y2_min; 863: y_max = (*s_etat_processus).y2_max; 864: 865: (*s_etat_processus).x2_min = (*((complex16 *) 866: (*s_objet_argument).objet)) 867: .partie_reelle - ((x_max - x_min) / ((double) 2)); 868: (*s_etat_processus).x2_max = (*((complex16 *) 869: (*s_objet_argument).objet)) 870: .partie_reelle + ((x_max - x_min) / ((double) 2)); 871: 872: (*s_etat_processus).y2_min = (*((complex16 *) 873: (*s_objet_argument).objet)) 874: .partie_imaginaire - ((y_max - y_min) / ((double) 2)); 875: (*s_etat_processus).y2_max = (*((complex16 *) 876: (*s_objet_argument).objet)) 877: .partie_imaginaire + ((y_max - y_min) / ((double) 2)); 878: } 879: } 880: else 881: { 882: liberation(s_etat_processus, s_objet_argument); 883: 884: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 885: return; 886: } 887: 888: liberation(s_etat_processus, s_objet_argument); 889: 890: if (test_cfsf(s_etat_processus, 52) == d_faux) 891: { 892: if ((*s_etat_processus).fichiers_graphiques != NULL) 893: { 894: appel_gnuplot(s_etat_processus, 'N'); 895: } 896: } 897: 898: return; 899: } 900: 901: 902: /* 903: ================================================================================ 904: Fonction 'cls' 905: ================================================================================ 906: Entrées : pointeur sur une structure struct_processus 907: -------------------------------------------------------------------------------- 908: Sorties : 909: -------------------------------------------------------------------------------- 910: Effets de bord : néant 911: ================================================================================ 912: */ 913: 914: void 915: instruction_cls(struct_processus *s_etat_processus) 916: { 917: (*s_etat_processus).erreur_execution = d_ex; 918: 919: if ((*s_etat_processus).affichage_arguments == 'Y') 920: { 921: printf("\n CLS "); 922: 923: if ((*s_etat_processus).langue == 'F') 924: { 925: printf("(effacement de la matrice statistique)\n\n"); 926: printf(" Aucun argument\n"); 927: } 928: else 929: { 930: printf("(purge of the statistical matrix)\n\n"); 931: printf(" No argument\n"); 932: } 933: 934: return; 935: } 936: else if ((*s_etat_processus).test_instruction == 'Y') 937: { 938: (*s_etat_processus).nombre_arguments = -1; 939: return; 940: } 941: 942: if (test_cfsf(s_etat_processus, 31) == d_vrai) 943: { 944: if (empilement_pile_last(s_etat_processus, 0) == d_erreur) 945: { 946: return; 947: } 948: } 949: 950: if (retrait_variable(s_etat_processus, ds_sdat, 'G') == d_erreur) 951: { 952: (*s_etat_processus).erreur_systeme = d_es; 953: return; 954: } 955: 956: return; 957: } 958: 959: 960: /* 961: ================================================================================ 962: Fonction 'comb' 963: ================================================================================ 964: Entrées : structure processus 965: -------------------------------------------------------------------------------- 966: Sorties : 967: -------------------------------------------------------------------------------- 968: Effets de bord : néant 969: ================================================================================ 970: */ 971: 972: void 973: instruction_comb(struct_processus *s_etat_processus) 974: { 975: integer8 k; 976: integer8 n; 977: integer8 cint_max; 978: 979: real8 c; 980: 981: struct_objet *s_objet_argument_1; 982: struct_objet *s_objet_argument_2; 983: struct_objet *s_objet_resultat; 984: 985: unsigned long i; 986: 987: (*s_etat_processus).erreur_execution = d_ex; 988: 989: if ((*s_etat_processus).affichage_arguments == 'Y') 990: { 991: printf("\n COMB "); 992: 993: if ((*s_etat_processus).langue == 'F') 994: { 995: printf("(combinaison)\n\n"); 996: } 997: else 998: { 999: printf("(combinaison)\n\n"); 1000: } 1001: 1002: printf(" 1: %s\n", d_INT); 1003: printf("-> 1: %s, %s\n", d_INT, d_REL); 1004: 1005: return; 1006: } 1007: else if ((*s_etat_processus).test_instruction == 'Y') 1008: { 1009: (*s_etat_processus).nombre_arguments = 2; 1010: return; 1011: } 1012: 1013: if (test_cfsf(s_etat_processus, 31) == d_vrai) 1014: { 1015: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 1016: { 1017: return; 1018: } 1019: } 1020: 1021: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1022: &s_objet_argument_1) == d_erreur) 1023: { 1024: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 1025: return; 1026: } 1027: 1028: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1029: &s_objet_argument_2) == d_erreur) 1030: { 1031: liberation(s_etat_processus, s_objet_argument_1); 1032: 1033: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 1034: return; 1035: } 1036: 1037: if (((*s_objet_argument_1).type == INT) && 1038: ((*s_objet_argument_2).type == INT)) 1039: { 1040: n = (*((integer8 *) (*s_objet_argument_2).objet)); 1041: k = (*((integer8 *) (*s_objet_argument_1).objet)); 1042: 1043: if ((n < 0) || (k < 0) || (k > n)) 1044: { 1045: liberation(s_etat_processus, s_objet_argument_1); 1046: liberation(s_etat_processus, s_objet_argument_2); 1047: 1048: (*s_etat_processus).erreur_execution = d_ex_argument_invalide; 1049: return; 1050: } 1051: 1052: f90combinaison(&n, &k, &c); 1053: 1054: for(i = 1, cint_max = 1; i < (8 * sizeof(integer8)) - 1; cint_max = 1055: (cint_max << 1) + 1, i++); 1056: 1057: if (c > cint_max) 1058: { 1059: if ((s_objet_resultat = allocation(s_etat_processus, REL)) 1060: == NULL) 1061: { 1062: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 1063: return; 1064: } 1065: 1066: (*((real8 *) (*s_objet_resultat).objet)) = c; 1067: } 1068: else 1069: { 1070: if ((s_objet_resultat = allocation(s_etat_processus, INT)) 1071: == NULL) 1072: { 1073: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 1074: return; 1075: } 1076: 1077: if (fabs(c - floor(c)) < fabs(ceil(c) - c)) 1078: { 1079: (*((integer8 *) (*s_objet_resultat).objet)) = 1080: (integer8) floor(c); 1081: } 1082: else 1083: { 1084: (*((integer8 *) (*s_objet_resultat).objet)) = 1085: 1 + (integer8) floor(c); 1086: } 1087: } 1088: } 1089: else 1090: { 1091: liberation(s_etat_processus, s_objet_argument_1); 1092: liberation(s_etat_processus, s_objet_argument_2); 1093: 1094: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 1095: return; 1096: } 1097: 1098: liberation(s_etat_processus, s_objet_argument_1); 1099: liberation(s_etat_processus, s_objet_argument_2); 1100: 1101: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1102: s_objet_resultat) == d_erreur) 1103: { 1104: return; 1105: } 1106: 1107: return; 1108: } 1109: 1110: 1111: /* 1112: ================================================================================ 1113: Fonction 'cols' 1114: ================================================================================ 1115: Entrées : pointeur sur une structure struct_processus 1116: -------------------------------------------------------------------------------- 1117: Sorties : 1118: -------------------------------------------------------------------------------- 1119: Effets de bord : néant 1120: ================================================================================ 1121: */ 1122: 1123: void 1124: instruction_cols(struct_processus *s_etat_processus) 1125: { 1126: struct_objet *s_objet_argument_1; 1127: struct_objet *s_objet_argument_2; 1128: 1129: (*s_etat_processus).erreur_execution = d_ex; 1130: 1131: if ((*s_etat_processus).affichage_arguments == 'Y') 1132: { 1133: printf("\n COLS "); 1134: 1135: if ((*s_etat_processus).langue == 'F') 1136: { 1137: printf("(définition des colonnes X et Y de la matrice " 1138: "statistique)\n\n"); 1139: } 1140: else 1141: { 1142: printf("(definition of X and Y columns in statistical matrix)\n\n"); 1143: } 1144: 1145: printf(" 2: %s\n", d_INT); 1146: printf(" 1: %s\n", d_INT); 1147: 1148: return; 1149: } 1150: else if ((*s_etat_processus).test_instruction == 'Y') 1151: { 1152: (*s_etat_processus).nombre_arguments = -1; 1153: return; 1154: } 1155: 1156: if (test_cfsf(s_etat_processus, 31) == d_vrai) 1157: { 1158: if (empilement_pile_last(s_etat_processus, 2) == d_erreur) 1159: { 1160: return; 1161: } 1162: } 1163: 1164: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1165: &s_objet_argument_1) == d_erreur) 1166: { 1167: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 1168: return; 1169: } 1170: 1171: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1172: &s_objet_argument_2) == d_erreur) 1173: { 1174: liberation(s_etat_processus, s_objet_argument_1); 1175: 1176: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 1177: return; 1178: } 1179: 1180: if (((*s_objet_argument_1).type == INT) && 1181: ((*s_objet_argument_2).type == INT)) 1182: { 1183: if (((*((integer8 *) (*s_objet_argument_1).objet)) <= 0) || 1184: ((*((integer8 *) (*s_objet_argument_2).objet)) <= 0)) 1185: { 1186: liberation(s_etat_processus, s_objet_argument_1); 1187: liberation(s_etat_processus, s_objet_argument_2); 1188: 1189: (*s_etat_processus).erreur_execution = d_ex_argument_invalide; 1190: return; 1191: } 1192: 1193: (*s_etat_processus).colonne_statistique_1 = 1194: (*((integer8 *) (*s_objet_argument_2).objet)); 1195: (*s_etat_processus).colonne_statistique_2 = 1196: (*((integer8 *) (*s_objet_argument_1).objet)); 1197: } 1198: else 1199: { 1200: liberation(s_etat_processus, s_objet_argument_1); 1201: liberation(s_etat_processus, s_objet_argument_2); 1202: 1203: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 1204: return; 1205: } 1206: 1207: liberation(s_etat_processus, s_objet_argument_1); 1208: liberation(s_etat_processus, s_objet_argument_2); 1209: 1210: return; 1211: } 1212: 1213: // vim: ts=4