Annotation of rpl/src/instructions_l5.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 'lcd->'
! 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_lcd_fleche(struct_processus *s_etat_processus)
! 40: {
! 41: file *descripteur;
! 42: file *descripteur_graphique;
! 43:
! 44: int caractere;
! 45:
! 46: struct_fichier_graphique *l_fichier_courant;
! 47:
! 48: struct_liste_chainee *l_element_courant;
! 49:
! 50: struct_objet *s_objet_argument;
! 51:
! 52: unsigned long nombre_elements;
! 53:
! 54: (*s_etat_processus).erreur_execution = d_ex;
! 55:
! 56: if ((*s_etat_processus).affichage_arguments == 'Y')
! 57: {
! 58: printf("\n LCD-> ");
! 59:
! 60: if ((*s_etat_processus).langue == 'F')
! 61: {
! 62: printf("(sauvegarde d'un fichier graphique)\n\n");
! 63: }
! 64: else
! 65: {
! 66: printf("(graphical file storage)\n\n");
! 67: }
! 68:
! 69: printf(" 1: %s, %s\n\n", d_CHN, d_LST);
! 70:
! 71: if ((*s_etat_processus).langue == 'F')
! 72: {
! 73: printf(" Utilisation :\n\n");
! 74: }
! 75: else
! 76: {
! 77: printf(" Usage:\n\n");
! 78: }
! 79:
! 80: printf(" \"filename\" LCD->\n");
! 81: printf(" { \"filename\" \"postscript eps enhanced monochrome "
! 82: "dashed\" } LCD->\n");
! 83:
! 84: return;
! 85: }
! 86: else if ((*s_etat_processus).test_instruction == 'Y')
! 87: {
! 88: (*s_etat_processus).nombre_arguments = -1;
! 89: return;
! 90: }
! 91:
! 92: nombre_elements = 0;
! 93:
! 94: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 95: {
! 96: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 97: {
! 98: return;
! 99: }
! 100: }
! 101:
! 102: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 103: &s_objet_argument) == d_erreur)
! 104: {
! 105: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 106: return;
! 107: }
! 108:
! 109: if ((*s_objet_argument).type == CHN)
! 110: {
! 111: if ((descripteur = fopen((unsigned char *) (*s_objet_argument).objet,
! 112: "w")) == NULL)
! 113: {
! 114: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 115: return;
! 116: }
! 117:
! 118: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
! 119:
! 120: while(l_fichier_courant != NULL)
! 121: {
! 122: if (fprintf(descripteur, "@ %c %d %lld %s\n",
! 123: ((*l_fichier_courant).presence_axes == d_faux) ? 'F' : 'T',
! 124: (*l_fichier_courant).dimensions,
! 125: (*l_fichier_courant).systeme_axes,
! 126: (*l_fichier_courant).type) < 0)
! 127: {
! 128: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 129: return;
! 130: }
! 131:
! 132: if ((descripteur_graphique = fopen((*l_fichier_courant).nom, "r"))
! 133: == NULL)
! 134: {
! 135: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 136: return;
! 137: }
! 138:
! 139: while((caractere = getc(descripteur_graphique)) != EOF)
! 140: {
! 141: if (putc(caractere, descripteur) < 0)
! 142: {
! 143: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 144: return;
! 145: }
! 146: }
! 147:
! 148: if (fclose(descripteur_graphique) != 0)
! 149: {
! 150: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 151: return;
! 152: }
! 153:
! 154: l_fichier_courant = (*l_fichier_courant).suivant;
! 155: }
! 156:
! 157: if (fclose(descripteur) != 0)
! 158: {
! 159: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 160: return;
! 161: }
! 162:
! 163: }
! 164: else if ((*s_objet_argument).type == LST)
! 165: {
! 166: l_element_courant = (struct_liste_chainee *) (*s_objet_argument).objet;
! 167:
! 168: while(l_element_courant != NULL)
! 169: {
! 170: if ((*(*l_element_courant).donnee).type != CHN)
! 171: {
! 172: liberation(s_etat_processus, s_objet_argument);
! 173:
! 174: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 175: return;
! 176: }
! 177:
! 178: nombre_elements++;
! 179:
! 180: switch(nombre_elements)
! 181: {
! 182: case 1 : /* Nom du fichier */
! 183: {
! 184: if (((*s_etat_processus).nom_fichier_gnuplot =
! 185: malloc((strlen((unsigned char *)
! 186: (*(*l_element_courant).donnee).objet) + 1) *
! 187: sizeof(unsigned char))) == NULL)
! 188: {
! 189: (*s_etat_processus).erreur_systeme =
! 190: d_es_allocation_memoire;
! 191: return;
! 192: }
! 193:
! 194: strcpy((*s_etat_processus).nom_fichier_gnuplot,
! 195: (unsigned char *) (*(*l_element_courant).donnee)
! 196: .objet);
! 197:
! 198: break;
! 199: }
! 200:
! 201: case 2 : /* Type de fichier */
! 202: {
! 203: if (((*s_etat_processus).type_fichier_gnuplot =
! 204: malloc((strlen((unsigned char *)
! 205: (*(*l_element_courant).donnee).objet) + 1) *
! 206: sizeof(unsigned char))) == NULL)
! 207: {
! 208: (*s_etat_processus).erreur_systeme =
! 209: d_es_allocation_memoire;
! 210: return;
! 211: }
! 212:
! 213: strcpy((*s_etat_processus).type_fichier_gnuplot,
! 214: (unsigned char *) (*(*l_element_courant).donnee)
! 215: .objet);
! 216:
! 217: break;
! 218: }
! 219:
! 220: default :
! 221: {
! 222: liberation(s_etat_processus, s_objet_argument);
! 223:
! 224: (*s_etat_processus).erreur_execution =
! 225: d_ex_argument_invalide;
! 226: return;
! 227: }
! 228: }
! 229:
! 230: l_element_courant = (*l_element_courant).suivant;
! 231: }
! 232:
! 233: appel_gnuplot(s_etat_processus, 'F');
! 234: }
! 235: else
! 236: {
! 237: liberation(s_etat_processus, s_objet_argument);
! 238:
! 239: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 240: return;
! 241: }
! 242:
! 243: liberation(s_etat_processus, s_objet_argument);
! 244:
! 245: return;
! 246: }
! 247:
! 248:
! 249: /*
! 250: ================================================================================
! 251: Fonction 'label'
! 252: ================================================================================
! 253: Entrées : pointeur sur une structure struct_processus
! 254: --------------------------------------------------------------------------------
! 255: Sorties :
! 256: --------------------------------------------------------------------------------
! 257: Effets de bord : néant
! 258: ================================================================================
! 259: */
! 260:
! 261: void
! 262: instruction_label(struct_processus *s_etat_processus)
! 263: {
! 264: struct_liste_chainee *l_element_courant;
! 265:
! 266: struct_objet *s_objet_argument;
! 267:
! 268: unsigned long nombre_labels;
! 269:
! 270: (*s_etat_processus).erreur_execution = d_ex;
! 271:
! 272: if ((*s_etat_processus).affichage_arguments == 'Y')
! 273: {
! 274: printf("\n LABEL ");
! 275:
! 276: if ((*s_etat_processus).langue == 'F')
! 277: {
! 278: printf("(spécification des labels sur les axes)\n\n");
! 279: }
! 280: else
! 281: {
! 282: printf("(axes labels specification)\n\n");
! 283: }
! 284:
! 285: printf(" 1: %s\n\n", d_LST);
! 286:
! 287: if ((*s_etat_processus).langue == 'F')
! 288: {
! 289: printf(" Utilisation :\n\n");
! 290: }
! 291: else
! 292: {
! 293: printf(" Usage:\n\n");
! 294: }
! 295:
! 296: printf(" { \"label X\" \"label Y\" \"label Z\" } LABEL\n");
! 297: printf(" { \"label X\" } LABEL\n");
! 298:
! 299: return;
! 300: }
! 301: else if ((*s_etat_processus).test_instruction == 'Y')
! 302: {
! 303: (*s_etat_processus).nombre_arguments = -1;
! 304: return;
! 305: }
! 306:
! 307: nombre_labels = 0;
! 308:
! 309: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 310: {
! 311: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 312: {
! 313: return;
! 314: }
! 315: }
! 316:
! 317: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 318: &s_objet_argument) == d_erreur)
! 319: {
! 320: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 321: return;
! 322: }
! 323:
! 324: if ((*s_objet_argument).type == LST)
! 325: {
! 326: l_element_courant = (struct_liste_chainee *) (*s_objet_argument).objet;
! 327:
! 328: while(l_element_courant != NULL)
! 329: {
! 330: if ((*(*l_element_courant).donnee).type != CHN)
! 331: {
! 332: liberation(s_etat_processus, s_objet_argument);
! 333:
! 334: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
! 335: return;
! 336: }
! 337:
! 338: nombre_labels++;
! 339:
! 340: switch(nombre_labels)
! 341: {
! 342: case 1 :
! 343: {
! 344: free((*s_etat_processus).label_x);
! 345:
! 346: if (((*s_etat_processus).label_x = malloc((strlen(
! 347: (unsigned char *) (*(*l_element_courant).donnee)
! 348: .objet) + 1) * sizeof(unsigned char))) == NULL)
! 349: {
! 350: (*s_etat_processus).erreur_systeme =
! 351: d_es_allocation_memoire;
! 352: return;
! 353: }
! 354:
! 355: strcpy((*s_etat_processus).label_x, (unsigned char *)
! 356: (*(*l_element_courant).donnee).objet);
! 357:
! 358: break;
! 359: }
! 360:
! 361: case 2 :
! 362: {
! 363: free((*s_etat_processus).label_y);
! 364:
! 365: if (((*s_etat_processus).label_y = malloc((strlen(
! 366: (unsigned char *) (*(*l_element_courant).donnee)
! 367: .objet) + 1) * sizeof(unsigned char))) == NULL)
! 368: {
! 369: (*s_etat_processus).erreur_systeme =
! 370: d_es_allocation_memoire;
! 371: return;
! 372: }
! 373:
! 374: strcpy((*s_etat_processus).label_y, (unsigned char *)
! 375: (*(*l_element_courant).donnee).objet);
! 376:
! 377: break;
! 378: }
! 379:
! 380: case 3 :
! 381: {
! 382: free((*s_etat_processus).label_z);
! 383:
! 384: if (((*s_etat_processus).label_z = malloc((strlen(
! 385: (unsigned char *) (*(*l_element_courant).donnee)
! 386: .objet) + 1) * sizeof(unsigned char))) == NULL)
! 387: {
! 388: (*s_etat_processus).erreur_systeme =
! 389: d_es_allocation_memoire;
! 390: return;
! 391: }
! 392:
! 393: strcpy((*s_etat_processus).label_z, (unsigned char *)
! 394: (*(*l_element_courant).donnee).objet);
! 395:
! 396: break;
! 397: }
! 398:
! 399: default :
! 400: {
! 401: liberation(s_etat_processus, s_objet_argument);
! 402:
! 403: (*s_etat_processus).erreur_execution =
! 404: d_ex_argument_invalide;
! 405: return;
! 406: }
! 407: }
! 408:
! 409: l_element_courant = (*l_element_courant).suivant;
! 410: }
! 411: }
! 412: else
! 413: {
! 414: liberation(s_etat_processus, s_objet_argument);
! 415:
! 416: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 417: return;
! 418: }
! 419:
! 420: liberation(s_etat_processus, s_objet_argument);
! 421:
! 422: if (test_cfsf(s_etat_processus, 52) == d_faux)
! 423: {
! 424: if ((*s_etat_processus).fichiers_graphiques != NULL)
! 425: {
! 426: appel_gnuplot(s_etat_processus, 'N');
! 427: }
! 428: }
! 429:
! 430: return;
! 431: }
! 432:
! 433:
! 434: /*
! 435: ================================================================================
! 436: Fonction 'logger'
! 437: ================================================================================
! 438: Entrées : pointeur sur une structure struct_processus
! 439: --------------------------------------------------------------------------------
! 440: Sorties :
! 441: --------------------------------------------------------------------------------
! 442: Effets de bord : néant
! 443: ================================================================================
! 444: */
! 445:
! 446: void
! 447: instruction_logger(struct_processus *s_etat_processus)
! 448: {
! 449: struct_objet *s_objet_argument;
! 450:
! 451: (*s_etat_processus).erreur_execution = d_ex;
! 452:
! 453: if ((*s_etat_processus).affichage_arguments == 'Y')
! 454: {
! 455: printf("\n LOGGER ");
! 456:
! 457: if ((*s_etat_processus).langue == 'F')
! 458: {
! 459: printf("(écriture d'un message de journalisation)\n\n");
! 460: }
! 461: else
! 462: {
! 463: printf("(send message to system logger)\n\n");
! 464: }
! 465:
! 466: printf(" 1: %s\n", d_CHN);
! 467:
! 468: return;
! 469: }
! 470: else if ((*s_etat_processus).test_instruction == 'Y')
! 471: {
! 472: (*s_etat_processus).nombre_arguments = -1;
! 473: return;
! 474: }
! 475:
! 476: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 477: {
! 478: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 479: {
! 480: return;
! 481: }
! 482: }
! 483:
! 484: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 485: &s_objet_argument) == d_erreur)
! 486: {
! 487: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 488: return;
! 489: }
! 490:
! 491: if ((*s_objet_argument).type == CHN)
! 492: {
! 493: syslog(LOG_NOTICE, "%s", (unsigned char *) (*s_objet_argument).objet);
! 494: }
! 495: else
! 496: {
! 497: liberation(s_etat_processus, s_objet_argument);
! 498:
! 499: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 500: return;
! 501: }
! 502:
! 503: liberation(s_etat_processus, s_objet_argument);
! 504:
! 505: return;
! 506: }
! 507:
! 508:
! 509: /*
! 510: ================================================================================
! 511: Fonction 'line'
! 512: ================================================================================
! 513: Entrées : pointeur sur une structure struct_processus
! 514: --------------------------------------------------------------------------------
! 515: Sorties :
! 516: --------------------------------------------------------------------------------
! 517: Effets de bord : néant
! 518: ================================================================================
! 519: */
! 520:
! 521: void
! 522: instruction_line(struct_processus *s_etat_processus)
! 523: {
! 524: file *fichier;
! 525:
! 526: struct_fichier_graphique *l_fichier_candidat;
! 527: struct_fichier_graphique *l_fichier_courant;
! 528: struct_fichier_graphique *l_fichier_precedent;
! 529:
! 530: struct_objet *s_objet_argument_1;
! 531: struct_objet *s_objet_argument_2;
! 532:
! 533: unsigned char *nom_fichier;
! 534:
! 535: (*s_etat_processus).erreur_execution = d_ex;
! 536:
! 537: if ((*s_etat_processus).affichage_arguments == 'Y')
! 538: {
! 539: printf("\n LINE ");
! 540:
! 541: if ((*s_etat_processus).langue == 'F')
! 542: {
! 543: printf("(dessin d'un segment)\n\n");
! 544: }
! 545: else
! 546: {
! 547: printf("(draw line)\n\n");
! 548: }
! 549:
! 550: printf(" 2: %s\n", d_CPL);
! 551: printf(" 1: %s\n", d_CPL);
! 552:
! 553: return;
! 554: }
! 555: else if ((*s_etat_processus).test_instruction == 'Y')
! 556: {
! 557: (*s_etat_processus).nombre_arguments = -1;
! 558: return;
! 559: }
! 560:
! 561: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 562: {
! 563: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
! 564: {
! 565: return;
! 566: }
! 567: }
! 568:
! 569: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 570: &s_objet_argument_1) == d_erreur)
! 571: {
! 572: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 573: return;
! 574: }
! 575:
! 576: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 577: &s_objet_argument_2) == d_erreur)
! 578: {
! 579: liberation(s_etat_processus, s_objet_argument_1);
! 580:
! 581: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 582: return;
! 583: }
! 584:
! 585: // Vérification du nombre de dimensions de l'espace
! 586:
! 587: if (((*s_objet_argument_1).type == CPL) &&
! 588: ((*s_objet_argument_2).type == CPL))
! 589: {
! 590: /*
! 591: * Vérification de la présence d'un fichier de dessin
! 592: * parmi la liste des fichiers graphiques
! 593: */
! 594:
! 595: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
! 596: l_fichier_candidat = NULL;
! 597:
! 598: while(l_fichier_courant != NULL)
! 599: {
! 600: if (strcmp((*l_fichier_courant).type, "DESSIN") == 0)
! 601: {
! 602: l_fichier_candidat = l_fichier_courant;
! 603: }
! 604:
! 605: l_fichier_courant = (*l_fichier_courant).suivant;
! 606: }
! 607:
! 608: l_fichier_courant = l_fichier_candidat;
! 609:
! 610: if ((l_fichier_courant == NULL) ||
! 611: ((*s_etat_processus).requete_nouveau_plan == d_vrai))
! 612: {
! 613: // Création d'un fichier
! 614:
! 615: (*s_etat_processus).requete_nouveau_plan = d_faux;
! 616:
! 617: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
! 618: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
! 619: {
! 620: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 621: return;
! 622: }
! 623:
! 624: if ((fichier = fopen(nom_fichier, "w+")) == NULL)
! 625: {
! 626: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 627: return;
! 628: }
! 629:
! 630: l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
! 631:
! 632: if (l_fichier_courant == NULL)
! 633: {
! 634: if (((*s_etat_processus).fichiers_graphiques =
! 635: malloc(sizeof(struct_fichier_graphique))) == NULL)
! 636: {
! 637: (*s_etat_processus).erreur_systeme =
! 638: d_es_allocation_memoire;
! 639: return;
! 640: }
! 641:
! 642: (*(*s_etat_processus).fichiers_graphiques).suivant = NULL;
! 643: (*(*s_etat_processus).fichiers_graphiques).nom = nom_fichier;
! 644: (*(*s_etat_processus).fichiers_graphiques).legende = NULL;
! 645: (*(*s_etat_processus).fichiers_graphiques).dimensions = 2;
! 646: (*(*s_etat_processus).fichiers_graphiques).presence_axes =
! 647: d_faux;
! 648: (*(*s_etat_processus).fichiers_graphiques).systeme_axes =
! 649: (*s_etat_processus).systeme_axes;
! 650: strcpy((*(*s_etat_processus).fichiers_graphiques).type,
! 651: "DESSIN");
! 652: }
! 653: else
! 654: {
! 655: while(l_fichier_courant != NULL)
! 656: {
! 657: if ((*l_fichier_courant).dimensions != 2)
! 658: {
! 659: (*s_etat_processus).erreur_execution =
! 660: d_ex_dimensions_differentes;
! 661: return;
! 662: }
! 663:
! 664: l_fichier_precedent = l_fichier_courant;
! 665: l_fichier_courant = (*l_fichier_courant).suivant;
! 666: }
! 667:
! 668: l_fichier_courant = l_fichier_precedent;
! 669:
! 670: if (((*l_fichier_courant).suivant =
! 671: malloc(sizeof(struct_fichier_graphique))) == NULL)
! 672: {
! 673: (*s_etat_processus).erreur_systeme =
! 674: d_es_allocation_memoire;
! 675: return;
! 676: }
! 677:
! 678: l_fichier_courant = (*l_fichier_courant).suivant;
! 679:
! 680: (*l_fichier_courant).suivant = NULL;
! 681: (*l_fichier_courant).nom = nom_fichier;
! 682: (*l_fichier_courant).legende = NULL;
! 683: (*l_fichier_courant).dimensions = 2;
! 684: (*l_fichier_courant).presence_axes = d_faux;
! 685: (*l_fichier_courant).systeme_axes =
! 686: (*s_etat_processus).systeme_axes;
! 687: strcpy((*l_fichier_courant).type, "DESSIN");
! 688: }
! 689: }
! 690: else
! 691: {
! 692: // Le fichier préexiste.
! 693:
! 694: if ((fichier = fopen((*l_fichier_courant).nom, "a")) == NULL)
! 695: {
! 696: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 697: return;
! 698: }
! 699: }
! 700:
! 701: /*
! 702: * Inscription du segment
! 703: */
! 704:
! 705: if (fprintf(fichier, "%f %f\n", (*((complex16 *)
! 706: (*s_objet_argument_2).objet)).partie_reelle, (*((complex16 *)
! 707: (*s_objet_argument_2).objet)).partie_imaginaire) < 0)
! 708: {
! 709: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 710: return;
! 711: }
! 712:
! 713: if (fprintf(fichier, "%f %f\n\n", (*((complex16 *)
! 714: (*s_objet_argument_1).objet)).partie_reelle, (*((complex16 *)
! 715: (*s_objet_argument_1).objet)).partie_imaginaire) < 0)
! 716: {
! 717: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 718: return;
! 719: }
! 720:
! 721: if (fclose(fichier) != 0)
! 722: {
! 723: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 724: return;
! 725: }
! 726:
! 727: (*s_etat_processus).mise_a_jour_trace_requise = d_vrai;
! 728: }
! 729: else
! 730: {
! 731: liberation(s_etat_processus, s_objet_argument_1);
! 732: liberation(s_etat_processus, s_objet_argument_2);
! 733:
! 734: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 735: return;
! 736: }
! 737:
! 738: liberation(s_etat_processus, s_objet_argument_1);
! 739: liberation(s_etat_processus, s_objet_argument_2);
! 740:
! 741: return;
! 742: }
! 743:
! 744:
! 745: /*
! 746: ================================================================================
! 747: Fonction 'lq'
! 748: ================================================================================
! 749: Entrées : pointeur sur une structure struct_processus
! 750: --------------------------------------------------------------------------------
! 751: Sorties :
! 752: --------------------------------------------------------------------------------
! 753: Effets de bord : néant
! 754: ================================================================================
! 755: */
! 756:
! 757: void
! 758: instruction_lq(struct_processus *s_etat_processus)
! 759: {
! 760: complex16 registre;
! 761: complex16 *tau_complexe;
! 762: complex16 *vecteur_complexe;
! 763:
! 764: real8 *tau_reel;
! 765: real8 *vecteur_reel;
! 766:
! 767: struct_liste_chainee *registre_pile_last;
! 768:
! 769: struct_objet *s_copie_argument;
! 770: struct_objet *s_matrice_identite;
! 771: struct_objet *s_objet;
! 772: struct_objet *s_objet_argument;
! 773: struct_objet *s_objet_resultat;
! 774:
! 775: unsigned long i;
! 776: unsigned long j;
! 777: unsigned long k;
! 778: unsigned long nombre_reflecteurs_elementaires;
! 779:
! 780: void *tau;
! 781:
! 782: (*s_etat_processus).erreur_execution = d_ex;
! 783:
! 784: if ((*s_etat_processus).affichage_arguments == 'Y')
! 785: {
! 786: printf("\n LQ ");
! 787:
! 788: if ((*s_etat_processus).langue == 'F')
! 789: {
! 790: printf("(décomposition LQ)\n\n");
! 791: }
! 792: else
! 793: {
! 794: printf("(LQ décomposition)\n\n");
! 795: }
! 796:
! 797: printf(" 1: %s, %s\n", d_MIN, d_MRL);
! 798: printf("-> 2: %s\n", d_MRL);
! 799: printf(" 1: %s\n\n", d_MRL);
! 800:
! 801: printf(" 1: %s\n", d_MCX);
! 802: printf("-> 2: %s\n", d_MCX);
! 803: printf(" 1: %s\n", d_MCX);
! 804:
! 805: return;
! 806: }
! 807: else if ((*s_etat_processus).test_instruction == 'Y')
! 808: {
! 809: (*s_etat_processus).nombre_arguments = -1;
! 810: return;
! 811: }
! 812:
! 813: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 814: {
! 815: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 816: {
! 817: return;
! 818: }
! 819: }
! 820:
! 821: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 822: &s_objet_argument) == d_erreur)
! 823: {
! 824: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 825: return;
! 826: }
! 827:
! 828: if (((*s_objet_argument).type == MIN) ||
! 829: ((*s_objet_argument).type == MRL))
! 830: {
! 831: /*
! 832: * Matrice entière ou réelle
! 833: */
! 834:
! 835: if ((s_copie_argument = copie_objet(s_etat_processus,
! 836: s_objet_argument, 'Q')) == NULL)
! 837: {
! 838: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 839: return;
! 840: }
! 841:
! 842: factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
! 843: (*s_copie_argument).type = MRL;
! 844:
! 845: tau_reel = (real8 *) tau;
! 846:
! 847: if ((*s_etat_processus).erreur_systeme != d_es)
! 848: {
! 849: return;
! 850: }
! 851:
! 852: if (((*s_etat_processus).exception != d_ep) ||
! 853: ((*s_etat_processus).erreur_execution != d_ex))
! 854: {
! 855: free(tau);
! 856: liberation(s_etat_processus, s_objet_argument);
! 857: liberation(s_etat_processus, s_copie_argument);
! 858: return;
! 859: }
! 860:
! 861: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 862: s_copie_argument, 'O')) == NULL)
! 863: {
! 864: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 865: return;
! 866: }
! 867:
! 868: // Matrice L
! 869:
! 870: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 871: .nombre_lignes; i++)
! 872: {
! 873: for(j = i + 1; j < (*((struct_matrice *) (*s_objet_resultat)
! 874: .objet)).nombre_colonnes; j++)
! 875: {
! 876: ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
! 877: .tableau)[i][j] = 0;
! 878: }
! 879: }
! 880:
! 881: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 882: s_objet_resultat) == d_erreur)
! 883: {
! 884: return;
! 885: }
! 886:
! 887: // Matrice Q
! 888:
! 889: nombre_reflecteurs_elementaires = ((*((struct_matrice *)
! 890: (*s_copie_argument).objet)).nombre_colonnes <
! 891: (*((struct_matrice *) (*s_copie_argument).objet))
! 892: .nombre_lignes) ? (*((struct_matrice *)
! 893: (*s_copie_argument).objet)).nombre_colonnes
! 894: : (*((struct_matrice *) (*s_copie_argument).objet))
! 895: .nombre_lignes;
! 896:
! 897: registre_pile_last = NULL;
! 898:
! 899: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 900: {
! 901: registre_pile_last = (*s_etat_processus).l_base_pile_last;
! 902: (*s_etat_processus).l_base_pile_last = NULL;
! 903: }
! 904:
! 905: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
! 906: {
! 907: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 908: return;
! 909: }
! 910:
! 911: (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
! 912: (*s_copie_argument).objet)).nombre_colonnes;
! 913:
! 914: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 915: s_objet) == d_erreur)
! 916: {
! 917: return;
! 918: }
! 919:
! 920: instruction_idn(s_etat_processus);
! 921:
! 922: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 923: ((*s_etat_processus).erreur_execution != d_ex) ||
! 924: ((*s_etat_processus).exception != d_ep))
! 925: {
! 926: liberation(s_etat_processus, s_copie_argument);
! 927: free(tau);
! 928:
! 929: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 930: {
! 931: return;
! 932: }
! 933:
! 934: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 935: return;
! 936: }
! 937:
! 938: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 939: &s_matrice_identite) == d_erreur)
! 940: {
! 941: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 942: return;
! 943: }
! 944:
! 945: for(i = 0; i < nombre_reflecteurs_elementaires; i++)
! 946: {
! 947: // Calcul de H(i) = I - tau * v * v'
! 948:
! 949: if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
! 950: 'P')) == NULL)
! 951: {
! 952: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 953: return;
! 954: }
! 955:
! 956: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 957: s_objet) == d_erreur)
! 958: {
! 959: return;
! 960: }
! 961:
! 962: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
! 963: {
! 964: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 965: return;
! 966: }
! 967:
! 968: (*((real8 *) (*s_objet).objet)) = tau_reel[i];
! 969:
! 970: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 971: s_objet) == d_erreur)
! 972: {
! 973: return;
! 974: }
! 975:
! 976: if ((s_objet = allocation(s_etat_processus, MRL)) == NULL)
! 977: {
! 978: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 979: return;
! 980: }
! 981:
! 982: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
! 983: (*((struct_matrice *) (*s_copie_argument).objet))
! 984: .nombre_colonnes;
! 985: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
! 986: (*((struct_matrice *) (*s_copie_argument).objet))
! 987: .nombre_colonnes;
! 988:
! 989: if ((vecteur_reel = malloc((*((struct_matrice *) (*s_objet).objet))
! 990: .nombre_lignes * sizeof(real8))) == NULL)
! 991: {
! 992: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 993: return;
! 994: }
! 995:
! 996: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
! 997: .nombre_lignes; j++)
! 998: {
! 999: if (j < i)
! 1000: {
! 1001: vecteur_reel[j] = 0;
! 1002: }
! 1003: else if (j == i)
! 1004: {
! 1005: vecteur_reel[j] = 1;
! 1006: }
! 1007: else
! 1008: {
! 1009: vecteur_reel[j] = ((real8 **) (*((struct_matrice *)
! 1010: (*s_copie_argument).objet)).tableau)[i][j];
! 1011: }
! 1012: }
! 1013:
! 1014: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
! 1015: malloc((*((struct_matrice *) (*s_objet).objet))
! 1016: .nombre_lignes * sizeof(real8 *))) == NULL)
! 1017: {
! 1018: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1019: return;
! 1020: }
! 1021:
! 1022: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
! 1023: .nombre_lignes; j++)
! 1024: {
! 1025: if ((((real8 **) (*((struct_matrice *) (*s_objet).objet))
! 1026: .tableau)[j] = malloc((*((struct_matrice *) (*s_objet)
! 1027: .objet)).nombre_lignes * sizeof(real8))) == NULL)
! 1028: {
! 1029: (*s_etat_processus).erreur_systeme =
! 1030: d_es_allocation_memoire;
! 1031: return;
! 1032: }
! 1033:
! 1034: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
! 1035: .nombre_colonnes; k++)
! 1036: {
! 1037: ((real8 **) (*((struct_matrice *) (*s_objet).objet))
! 1038: .tableau)[j][k] = vecteur_reel[j] * vecteur_reel[k];
! 1039: }
! 1040: }
! 1041:
! 1042: free(vecteur_reel);
! 1043:
! 1044: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1045: s_objet) == d_erreur)
! 1046: {
! 1047: return;
! 1048: }
! 1049:
! 1050: instruction_multiplication(s_etat_processus);
! 1051:
! 1052: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1053: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1054: ((*s_etat_processus).exception != d_ep))
! 1055: {
! 1056: liberation(s_etat_processus, s_copie_argument);
! 1057: liberation(s_etat_processus, s_matrice_identite);
! 1058: free(tau);
! 1059:
! 1060: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1061: {
! 1062: return;
! 1063: }
! 1064:
! 1065: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1066: return;
! 1067: }
! 1068:
! 1069: instruction_moins(s_etat_processus);
! 1070:
! 1071: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1072: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1073: ((*s_etat_processus).exception != d_ep))
! 1074: {
! 1075: liberation(s_etat_processus, s_copie_argument);
! 1076: liberation(s_etat_processus, s_matrice_identite);
! 1077: free(tau);
! 1078:
! 1079: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1080: {
! 1081: return;
! 1082: }
! 1083:
! 1084: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1085: return;
! 1086: }
! 1087:
! 1088: if (i > 0)
! 1089: {
! 1090: instruction_swap(s_etat_processus);
! 1091:
! 1092: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1093: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1094: ((*s_etat_processus).exception != d_ep))
! 1095: {
! 1096: liberation(s_etat_processus, s_copie_argument);
! 1097: liberation(s_etat_processus, s_matrice_identite);
! 1098: free(tau);
! 1099:
! 1100: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1101: {
! 1102: return;
! 1103: }
! 1104:
! 1105: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1106: return;
! 1107: }
! 1108:
! 1109: instruction_multiplication(s_etat_processus);
! 1110:
! 1111: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1112: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1113: ((*s_etat_processus).exception != d_ep))
! 1114: {
! 1115: liberation(s_etat_processus, s_copie_argument);
! 1116: liberation(s_etat_processus, s_matrice_identite);
! 1117: free(tau);
! 1118:
! 1119: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1120: {
! 1121: return;
! 1122: }
! 1123:
! 1124: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1125: return;
! 1126: }
! 1127: }
! 1128: }
! 1129:
! 1130: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1131: {
! 1132: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1133: {
! 1134: return;
! 1135: }
! 1136:
! 1137: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1138: }
! 1139:
! 1140: liberation(s_etat_processus, s_matrice_identite);
! 1141: liberation(s_etat_processus, s_copie_argument);
! 1142: free(tau);
! 1143: }
! 1144: else if ((*s_objet_argument).type == MCX)
! 1145: {
! 1146: /*
! 1147: * Matrice complexe
! 1148: */
! 1149:
! 1150: if ((s_copie_argument = copie_objet(s_etat_processus,
! 1151: s_objet_argument, 'Q')) == NULL)
! 1152: {
! 1153: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1154: return;
! 1155: }
! 1156:
! 1157: factorisation_lq(s_etat_processus, (*s_copie_argument).objet, &tau);
! 1158:
! 1159: tau_complexe = (complex16 *) tau;
! 1160:
! 1161: if ((*s_etat_processus).erreur_systeme != d_es)
! 1162: {
! 1163: return;
! 1164: }
! 1165:
! 1166: if (((*s_etat_processus).exception != d_ep) ||
! 1167: ((*s_etat_processus).erreur_execution != d_ex))
! 1168: {
! 1169: free(tau);
! 1170: liberation(s_etat_processus, s_objet_argument);
! 1171: liberation(s_etat_processus, s_copie_argument);
! 1172: return;
! 1173: }
! 1174:
! 1175: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 1176: s_copie_argument, 'O')) == NULL)
! 1177: {
! 1178: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1179: return;
! 1180: }
! 1181:
! 1182: // Matrice L
! 1183:
! 1184: for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
! 1185: .nombre_lignes; i++)
! 1186: {
! 1187: for(j = i + 1; j < (*((struct_matrice *) (*s_objet_resultat)
! 1188: .objet)).nombre_colonnes; j++)
! 1189: {
! 1190: ((complex16 **) (*((struct_matrice *)
! 1191: (*s_objet_resultat).objet)).tableau)[i][j]
! 1192: .partie_reelle = 0;
! 1193: ((complex16 **) (*((struct_matrice *)
! 1194: (*s_objet_resultat).objet)).tableau)[i][j]
! 1195: .partie_imaginaire = 0;
! 1196: }
! 1197: }
! 1198:
! 1199: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1200: s_objet_resultat) == d_erreur)
! 1201: {
! 1202: return;
! 1203: }
! 1204:
! 1205: // Matrice Q
! 1206:
! 1207: nombre_reflecteurs_elementaires = ((*((struct_matrice *)
! 1208: (*s_copie_argument).objet)).nombre_colonnes <
! 1209: (*((struct_matrice *) (*s_copie_argument).objet))
! 1210: .nombre_lignes) ? (*((struct_matrice *)
! 1211: (*s_copie_argument).objet)).nombre_colonnes
! 1212: : (*((struct_matrice *) (*s_copie_argument).objet))
! 1213: .nombre_lignes;
! 1214:
! 1215: registre_pile_last = NULL;
! 1216:
! 1217: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1218: {
! 1219: registre_pile_last = (*s_etat_processus).l_base_pile_last;
! 1220: (*s_etat_processus).l_base_pile_last = NULL;
! 1221: }
! 1222:
! 1223: if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
! 1224: {
! 1225: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1226: return;
! 1227: }
! 1228:
! 1229: (*((integer8 *) (*s_objet).objet)) = (*((struct_matrice *)
! 1230: (*s_copie_argument).objet)).nombre_colonnes;
! 1231:
! 1232: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1233: s_objet) == d_erreur)
! 1234: {
! 1235: return;
! 1236: }
! 1237:
! 1238: instruction_idn(s_etat_processus);
! 1239:
! 1240: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1241: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1242: ((*s_etat_processus).exception != d_ep))
! 1243: {
! 1244: liberation(s_etat_processus, s_copie_argument);
! 1245: free(tau);
! 1246:
! 1247: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1248: {
! 1249: return;
! 1250: }
! 1251:
! 1252: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1253: return;
! 1254: }
! 1255:
! 1256: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1257: &s_matrice_identite) == d_erreur)
! 1258: {
! 1259: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1260: return;
! 1261: }
! 1262:
! 1263: for(i = 0; i < nombre_reflecteurs_elementaires; i++)
! 1264: {
! 1265: // Calcul de H'(i) = (I - tau * v * v')'
! 1266:
! 1267: if ((s_objet = copie_objet(s_etat_processus, s_matrice_identite,
! 1268: 'P')) == NULL)
! 1269: {
! 1270: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1271: return;
! 1272: }
! 1273:
! 1274: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1275: s_objet) == d_erreur)
! 1276: {
! 1277: return;
! 1278: }
! 1279:
! 1280: if ((s_objet = allocation(s_etat_processus, CPL)) == NULL)
! 1281: {
! 1282: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1283: return;
! 1284: }
! 1285:
! 1286: (*((complex16 *) (*s_objet).objet)) = tau_complexe[i];
! 1287:
! 1288: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1289: s_objet) == d_erreur)
! 1290: {
! 1291: return;
! 1292: }
! 1293:
! 1294: if ((s_objet = allocation(s_etat_processus, MCX)) == NULL)
! 1295: {
! 1296: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1297: return;
! 1298: }
! 1299:
! 1300: (*((struct_matrice *) (*s_objet).objet)).nombre_lignes =
! 1301: (*((struct_matrice *) (*s_copie_argument).objet))
! 1302: .nombre_colonnes;
! 1303: (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes =
! 1304: (*((struct_matrice *) (*s_copie_argument).objet))
! 1305: .nombre_colonnes;
! 1306:
! 1307: if ((vecteur_complexe = malloc((*((struct_matrice *)
! 1308: (*s_objet).objet)).nombre_lignes * sizeof(complex16)))
! 1309: == NULL)
! 1310: {
! 1311: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1312: return;
! 1313: }
! 1314:
! 1315: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
! 1316: .nombre_lignes; j++)
! 1317: {
! 1318: if (j < i)
! 1319: {
! 1320: vecteur_complexe[j].partie_reelle = 0;
! 1321: vecteur_complexe[j].partie_imaginaire = 0;
! 1322: }
! 1323: else if (j == i)
! 1324: {
! 1325: vecteur_complexe[j].partie_reelle = 1;
! 1326: vecteur_complexe[j].partie_imaginaire = 0;
! 1327: }
! 1328: else
! 1329: {
! 1330: vecteur_complexe[j].partie_reelle =
! 1331: ((complex16 **) (*((struct_matrice *)
! 1332: (*s_copie_argument).objet)).tableau)[i][j]
! 1333: .partie_reelle;
! 1334: vecteur_complexe[j].partie_imaginaire =
! 1335: -((complex16 **) (*((struct_matrice *)
! 1336: (*s_copie_argument).objet)).tableau)[i][j]
! 1337: .partie_imaginaire;
! 1338: }
! 1339: }
! 1340:
! 1341: if (((*((struct_matrice *) (*s_objet).objet)).tableau =
! 1342: malloc((*((struct_matrice *) (*s_objet).objet))
! 1343: .nombre_lignes * sizeof(complex16 *))) == NULL)
! 1344: {
! 1345: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1346: return;
! 1347: }
! 1348:
! 1349: for(j = 0; j < (*((struct_matrice *) (*s_objet).objet))
! 1350: .nombre_lignes; j++)
! 1351: {
! 1352: if ((((complex16 **) (*((struct_matrice *) (*s_objet).objet))
! 1353: .tableau)[j] = malloc((*((struct_matrice *) (*s_objet)
! 1354: .objet)).nombre_lignes * sizeof(complex16))) == NULL)
! 1355: {
! 1356: (*s_etat_processus).erreur_systeme =
! 1357: d_es_allocation_memoire;
! 1358: return;
! 1359: }
! 1360:
! 1361: for(k = 0; k < (*((struct_matrice *) (*s_objet).objet))
! 1362: .nombre_colonnes; k++)
! 1363: {
! 1364: registre = vecteur_complexe[k];
! 1365: registre.partie_imaginaire = -registre.partie_imaginaire;
! 1366:
! 1367: f77multiplicationcc_(&(vecteur_complexe[j]), ®istre,
! 1368: &(((complex16 **) (*((struct_matrice *)
! 1369: (*s_objet).objet)).tableau)[j][k]));
! 1370: }
! 1371: }
! 1372:
! 1373: free(vecteur_complexe);
! 1374:
! 1375: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1376: s_objet) == d_erreur)
! 1377: {
! 1378: return;
! 1379: }
! 1380:
! 1381: instruction_multiplication(s_etat_processus);
! 1382:
! 1383: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1384: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1385: ((*s_etat_processus).exception != d_ep))
! 1386: {
! 1387: liberation(s_etat_processus, s_copie_argument);
! 1388: liberation(s_etat_processus, s_matrice_identite);
! 1389: free(tau);
! 1390:
! 1391: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1392: {
! 1393: return;
! 1394: }
! 1395:
! 1396: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1397: return;
! 1398: }
! 1399:
! 1400: instruction_moins(s_etat_processus);
! 1401:
! 1402: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1403: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1404: ((*s_etat_processus).exception != d_ep))
! 1405: {
! 1406: liberation(s_etat_processus, s_copie_argument);
! 1407: liberation(s_etat_processus, s_matrice_identite);
! 1408: free(tau);
! 1409:
! 1410: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1411: {
! 1412: return;
! 1413: }
! 1414:
! 1415: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1416: return;
! 1417: }
! 1418:
! 1419: instruction_trn(s_etat_processus);
! 1420:
! 1421: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1422: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1423: ((*s_etat_processus).exception != d_ep))
! 1424: {
! 1425: liberation(s_etat_processus, s_copie_argument);
! 1426: liberation(s_etat_processus, s_matrice_identite);
! 1427: free(tau);
! 1428:
! 1429: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1430: {
! 1431: return;
! 1432: }
! 1433:
! 1434: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1435: return;
! 1436: }
! 1437:
! 1438: if (i > 0)
! 1439: {
! 1440: instruction_swap(s_etat_processus);
! 1441:
! 1442: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1443: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1444: ((*s_etat_processus).exception != d_ep))
! 1445: {
! 1446: liberation(s_etat_processus, s_copie_argument);
! 1447: liberation(s_etat_processus, s_matrice_identite);
! 1448: free(tau);
! 1449:
! 1450: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1451: {
! 1452: return;
! 1453: }
! 1454:
! 1455: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1456: return;
! 1457: }
! 1458:
! 1459: instruction_multiplication(s_etat_processus);
! 1460:
! 1461: if (((*s_etat_processus).erreur_systeme != d_es) ||
! 1462: ((*s_etat_processus).erreur_execution != d_ex) ||
! 1463: ((*s_etat_processus).exception != d_ep))
! 1464: {
! 1465: liberation(s_etat_processus, s_copie_argument);
! 1466: liberation(s_etat_processus, s_matrice_identite);
! 1467: free(tau);
! 1468:
! 1469: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1470: {
! 1471: return;
! 1472: }
! 1473:
! 1474: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1475: return;
! 1476: }
! 1477: }
! 1478: }
! 1479:
! 1480: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1481: {
! 1482: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 1483: {
! 1484: return;
! 1485: }
! 1486:
! 1487: (*s_etat_processus).l_base_pile_last = registre_pile_last;
! 1488: }
! 1489:
! 1490: liberation(s_etat_processus, s_matrice_identite);
! 1491: liberation(s_etat_processus, s_copie_argument);
! 1492: free(tau);
! 1493: }
! 1494:
! 1495: /*
! 1496: * Type d'argument invalide
! 1497: */
! 1498:
! 1499: else
! 1500: {
! 1501: liberation(s_etat_processus, s_objet_argument);
! 1502:
! 1503: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1504: return;
! 1505: }
! 1506:
! 1507: liberation(s_etat_processus, s_objet_argument);
! 1508:
! 1509: return;
! 1510: }
! 1511:
! 1512:
! 1513: /*
! 1514: ================================================================================
! 1515: Fonction 'localization'
! 1516: ================================================================================
! 1517: Entrées : pointeur sur une structure struct_processus
! 1518: --------------------------------------------------------------------------------
! 1519: Sorties :
! 1520: --------------------------------------------------------------------------------
! 1521: Effets de bord : néant
! 1522: ================================================================================
! 1523: */
! 1524:
! 1525: void
! 1526: instruction_localization(struct_processus *s_etat_processus)
! 1527: {
! 1528: struct_objet *s_objet_argument;
! 1529:
! 1530: (*s_etat_processus).erreur_execution = d_ex;
! 1531:
! 1532: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1533: {
! 1534: printf("\n LOCALIZATION ");
! 1535:
! 1536: if ((*s_etat_processus).langue == 'F')
! 1537: {
! 1538: printf("(spécifie les variables de localisation)\n\n");
! 1539: }
! 1540: else
! 1541: {
! 1542: printf("(set locales)\n\n");
! 1543: }
! 1544:
! 1545: printf(" 1: %s\n", d_CHN);
! 1546: return;
! 1547: }
! 1548: else if ((*s_etat_processus).test_instruction == 'Y')
! 1549: {
! 1550: (*s_etat_processus).nombre_arguments = -1;
! 1551: return;
! 1552: }
! 1553:
! 1554: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1555: {
! 1556: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1557: {
! 1558: return;
! 1559: }
! 1560: }
! 1561:
! 1562: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1563: &s_objet_argument) == d_erreur)
! 1564: {
! 1565: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1566: return;
! 1567: }
! 1568:
! 1569: if ((*s_objet_argument).type == CHN)
! 1570: {
! 1571: if (setlocale(LC_ALL, (unsigned char *) (*s_objet_argument).objet)
! 1572: == NULL)
! 1573: {
! 1574: liberation(s_etat_processus, s_objet_argument);
! 1575:
! 1576: (*s_etat_processus).erreur_execution = d_ex_locales;
! 1577: return;
! 1578: }
! 1579: }
! 1580: else
! 1581: {
! 1582: liberation(s_etat_processus, s_objet_argument);
! 1583:
! 1584: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1585: return;
! 1586: }
! 1587:
! 1588: liberation(s_etat_processus, s_objet_argument);
! 1589:
! 1590: return;
! 1591: }
! 1592:
! 1593:
! 1594: /*
! 1595: ================================================================================
! 1596: Fonction 'lcase'
! 1597: ================================================================================
! 1598: Entrées : pointeur sur une structure struct_processus
! 1599: --------------------------------------------------------------------------------
! 1600: Sorties :
! 1601: --------------------------------------------------------------------------------
! 1602: Effets de bord : néant
! 1603: ================================================================================
! 1604: */
! 1605:
! 1606: void
! 1607: instruction_lcase(struct_processus *s_etat_processus)
! 1608: {
! 1609: struct_objet *s_objet_argument;
! 1610: struct_objet *s_objet_resultat;
! 1611:
! 1612: unsigned char *ptr;
! 1613: unsigned char registre;
! 1614:
! 1615: (*s_etat_processus).erreur_execution = d_ex;
! 1616:
! 1617: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1618: {
! 1619: printf("\n LCASE ");
! 1620:
! 1621: if ((*s_etat_processus).langue == 'F')
! 1622: {
! 1623: printf("(converison d'une chaîne de caractères en minuscules)\n\n");
! 1624: }
! 1625: else
! 1626: {
! 1627: printf("(convert string to lower case)\n\n");
! 1628: }
! 1629:
! 1630: printf(" 1: %s\n", d_CHN);
! 1631: return;
! 1632: }
! 1633: else if ((*s_etat_processus).test_instruction == 'Y')
! 1634: {
! 1635: (*s_etat_processus).nombre_arguments = -1;
! 1636: return;
! 1637: }
! 1638:
! 1639: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1640: {
! 1641: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 1642: {
! 1643: return;
! 1644: }
! 1645: }
! 1646:
! 1647: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1648: &s_objet_argument) == d_erreur)
! 1649: {
! 1650: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1651: return;
! 1652: }
! 1653:
! 1654: if ((*s_objet_argument).type == CHN)
! 1655: {
! 1656: if ((s_objet_resultat = copie_objet(s_etat_processus,
! 1657: s_objet_argument, 'O')) == NULL)
! 1658: {
! 1659: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1660: return;
! 1661: }
! 1662:
! 1663: liberation(s_etat_processus, s_objet_argument);
! 1664: ptr = (unsigned char *) (*s_objet_resultat).objet;
! 1665:
! 1666: while((*ptr) != d_code_fin_chaine)
! 1667: {
! 1668: registre = tolower((*ptr));
! 1669:
! 1670: if (toupper(registre) == (*ptr))
! 1671: {
! 1672: (*ptr) = registre;
! 1673: }
! 1674:
! 1675: ptr++;
! 1676: }
! 1677:
! 1678: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1679: s_objet_resultat) == d_erreur)
! 1680: {
! 1681: return;
! 1682: }
! 1683: }
! 1684: else
! 1685: {
! 1686: liberation(s_etat_processus, s_objet_argument);
! 1687:
! 1688: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1689: return;
! 1690: }
! 1691:
! 1692: return;
! 1693: }
! 1694:
! 1695: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>