![]() ![]() | ![]() |
Passage de la branche 4.1 en branche stable.
1: /* 2: ================================================================================ 3: RPL/2 (R) version 4.1.0 4: Copyright (C) 1989-2011 Dr. BERTRAND Joël 5: 6: This file is part of RPL/2. 7: 8: RPL/2 is free software; you can redistribute it and/or modify it 9: under the terms of the CeCILL V2 License as published by the french 10: CEA, CNRS and INRIA. 11: 12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT 13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License 15: for more details. 16: 17: You should have received a copy of the CeCILL License 18: along with RPL/2. If not, write to info@cecill.info. 19: ================================================================================ 20: */ 21: 22: 23: #include "rpl-conv.h" 24: 25: 26: /* 27: ================================================================================ 28: Fonction '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: printf("-> 1: %s\n", d_CHN); 1632: return; 1633: } 1634: else if ((*s_etat_processus).test_instruction == 'Y') 1635: { 1636: (*s_etat_processus).nombre_arguments = -1; 1637: return; 1638: } 1639: 1640: if (test_cfsf(s_etat_processus, 31) == d_vrai) 1641: { 1642: if (empilement_pile_last(s_etat_processus, 1) == d_erreur) 1643: { 1644: return; 1645: } 1646: } 1647: 1648: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1649: &s_objet_argument) == d_erreur) 1650: { 1651: (*s_etat_processus).erreur_execution = d_ex_manque_argument; 1652: return; 1653: } 1654: 1655: if ((*s_objet_argument).type == CHN) 1656: { 1657: if ((s_objet_resultat = copie_objet(s_etat_processus, 1658: s_objet_argument, 'O')) == NULL) 1659: { 1660: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire; 1661: return; 1662: } 1663: 1664: liberation(s_etat_processus, s_objet_argument); 1665: ptr = (unsigned char *) (*s_objet_resultat).objet; 1666: 1667: while((*ptr) != d_code_fin_chaine) 1668: { 1669: registre = tolower((*ptr)); 1670: 1671: if (toupper(registre) == (*ptr)) 1672: { 1673: (*ptr) = registre; 1674: } 1675: 1676: ptr++; 1677: } 1678: 1679: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile), 1680: s_objet_resultat) == d_erreur) 1681: { 1682: return; 1683: } 1684: } 1685: else 1686: { 1687: liberation(s_etat_processus, s_objet_argument); 1688: 1689: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument; 1690: return; 1691: } 1692: 1693: return; 1694: } 1695: 1696: 1697: /* 1698: ================================================================================ 1699: Fonction 'l->t' 1700: ================================================================================ 1701: Entrées : pointeur sur une structure struct_processus 1702: -------------------------------------------------------------------------------- 1703: Sorties : 1704: -------------------------------------------------------------------------------- 1705: Effets de bord : néant 1706: ================================================================================ 1707: */ 1708: 1709: void 1710: instruction_l_vers_t(struct_processus *s_etat_processus) 1711: { 1712: logical1 last; 1713: 1714: (*s_etat_processus).erreur_execution = d_ex; 1715: 1716: if ((*s_etat_processus).affichage_arguments == 'Y') 1717: { 1718: printf("\n L->T "); 1719: 1720: if ((*s_etat_processus).langue == 'F') 1721: { 1722: printf("(converison d'une liste en table)\n\n"); 1723: } 1724: else 1725: { 1726: printf("(convert list to table)\n\n"); 1727: } 1728: 1729: printf(" 1: %s\n", d_LST); 1730: printf("-> 1: %s\n", d_TAB); 1731: return; 1732: } 1733: else if ((*s_etat_processus).test_instruction == 'Y') 1734: { 1735: (*s_etat_processus).nombre_arguments = -1; 1736: return; 1737: } 1738: 1739: if (test_cfsf(s_etat_processus, 31) == d_vrai) 1740: { 1741: last = d_vrai; 1742: cf(s_etat_processus, 31); 1743: 1744: if (empilement_pile_last(s_etat_processus, 1) == d_erreur) 1745: { 1746: return; 1747: } 1748: } 1749: else 1750: { 1751: last = d_faux; 1752: } 1753: 1754: instruction_list_fleche(s_etat_processus); 1755: 1756: if (((*s_etat_processus).erreur_systeme == d_es) && 1757: ((*s_etat_processus).erreur_execution == d_ex)) 1758: { 1759: instruction_fleche_table(s_etat_processus); 1760: } 1761: 1762: if (last == d_vrai) 1763: { 1764: sf(s_etat_processus, 31); 1765: } 1766: 1767: return; 1768: } 1769: 1770: // vim: ts=4