Annotation of rpl/src/instructions_d2.c, revision 1.1
1.1 ! bertrand 1: /*
! 2: ================================================================================
! 3: RPL/2 (R) version 4.0.9
! 4: Copyright (C) 1989-2010 Dr. BERTRAND Joël
! 5:
! 6: This file is part of RPL/2.
! 7:
! 8: RPL/2 is free software; you can redistribute it and/or modify it
! 9: under the terms of the CeCILL V2 License as published by the french
! 10: CEA, CNRS and INRIA.
! 11:
! 12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
! 13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
! 14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
! 15: for more details.
! 16:
! 17: You should have received a copy of the CeCILL License
! 18: along with RPL/2. If not, write to info@cecill.info.
! 19: ================================================================================
! 20: */
! 21:
! 22:
! 23: #include "rpl.conv.h"
! 24:
! 25:
! 26: /*
! 27: ================================================================================
! 28: Fonction '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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_d2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src