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