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