Annotation of rpl/src/instructions_c4.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: #include "convert.conv.h"
! 25:
! 26:
! 27: /*
! 28: ================================================================================
! 29: Fonction 'cov'
! 30: ================================================================================
! 31: Entrées :
! 32: --------------------------------------------------------------------------------
! 33: Sorties :
! 34: --------------------------------------------------------------------------------
! 35: Effets de bord : néant
! 36: ================================================================================
! 37: */
! 38:
! 39: void
! 40: instruction_cov(struct_processus *s_etat_processus)
! 41: {
! 42: integer8 nombre_colonnes;
! 43:
! 44: logical1 erreur;
! 45: logical1 presence_variable;
! 46:
! 47: long i;
! 48:
! 49: struct_objet *s_objet_statistique;
! 50: struct_objet *s_objet_resultat;
! 51:
! 52: (*s_etat_processus).erreur_execution = d_ex;
! 53:
! 54: if ((*s_etat_processus).affichage_arguments == 'Y')
! 55: {
! 56: printf("\n COV ");
! 57:
! 58: if ((*s_etat_processus).langue == 'F')
! 59: {
! 60: printf("(covariance)\n\n");
! 61: }
! 62: else
! 63: {
! 64: printf("(covariance)\n\n");
! 65: }
! 66:
! 67: printf("-> 1: %s\n", d_REL);
! 68:
! 69: return;
! 70: }
! 71: else if ((*s_etat_processus).test_instruction == 'Y')
! 72: {
! 73: (*s_etat_processus).nombre_arguments = -1;
! 74: return;
! 75: }
! 76:
! 77: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 78: {
! 79: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 80: {
! 81: return;
! 82: }
! 83: }
! 84:
! 85: /*
! 86: * Recherche d'une variable globale référencée par SIGMA
! 87: */
! 88:
! 89: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
! 90: {
! 91: /*
! 92: * Aucune variable SIGMA
! 93: */
! 94:
! 95: (*s_etat_processus).erreur_systeme = d_es;
! 96: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 97: return;
! 98: }
! 99: else
! 100: {
! 101: /*
! 102: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
! 103: * d'une variable SIGMA globale...
! 104: */
! 105:
! 106: i = (*s_etat_processus).position_variable_courante;
! 107: presence_variable = d_faux;
! 108:
! 109: while(i >= 0)
! 110: {
! 111: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
! 112: ds_sdat) == 0) && ((*s_etat_processus)
! 113: .s_liste_variables[i].niveau == 1))
! 114: {
! 115: presence_variable = d_vrai;
! 116: break;
! 117: }
! 118:
! 119: i--;
! 120: }
! 121:
! 122: if (presence_variable == d_faux)
! 123: {
! 124: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 125: return;
! 126: }
! 127: else
! 128: {
! 129: (*s_etat_processus).position_variable_courante = i;
! 130:
! 131: if ((*s_etat_processus).s_liste_variables
! 132: [(*s_etat_processus).position_variable_courante].objet
! 133: == NULL)
! 134: {
! 135: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
! 136: return;
! 137: }
! 138:
! 139: if (((*((*s_etat_processus).s_liste_variables
! 140: [(*s_etat_processus).position_variable_courante].objet))
! 141: .type != MIN) && ((*((*s_etat_processus)
! 142: .s_liste_variables[(*s_etat_processus)
! 143: .position_variable_courante].objet)).type != MRL))
! 144: {
! 145: (*s_etat_processus).erreur_execution =
! 146: d_ex_matrice_statistique_invalide;
! 147: return;
! 148: }
! 149:
! 150: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
! 151: .s_liste_variables[(*s_etat_processus)
! 152: .position_variable_courante].objet)).objet))
! 153: .nombre_colonnes;
! 154: }
! 155: }
! 156:
! 157: s_objet_statistique = ((*s_etat_processus).s_liste_variables
! 158: [(*s_etat_processus).position_variable_courante]).objet;
! 159:
! 160: if (((*s_objet_statistique).type == MIN) ||
! 161: ((*s_objet_statistique).type == MRL))
! 162: {
! 163: if (((*s_etat_processus).colonne_statistique_1 < 1) ||
! 164: ((*s_etat_processus).colonne_statistique_2 < 1) ||
! 165: ((*s_etat_processus).colonne_statistique_1 > nombre_colonnes) ||
! 166: ((*s_etat_processus).colonne_statistique_2 > nombre_colonnes))
! 167: {
! 168: (*s_etat_processus).erreur_execution =
! 169: d_ex_observations_inexistantes;
! 170: return;
! 171: }
! 172:
! 173: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 174: == NULL)
! 175: {
! 176: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 177: return;
! 178: }
! 179:
! 180: (*((real8 *) (*s_objet_resultat).objet)) = covariance_statistique(
! 181: (struct_matrice *) (*s_objet_statistique).objet,
! 182: (*s_etat_processus).colonne_statistique_1,
! 183: (*s_etat_processus).colonne_statistique_2, 'E', &erreur);
! 184:
! 185: if (erreur == d_erreur)
! 186: {
! 187: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 188: return;
! 189: }
! 190: }
! 191: else
! 192: {
! 193: (*s_etat_processus).erreur_execution =
! 194: d_ex_matrice_statistique_invalide;
! 195: return;
! 196: }
! 197:
! 198: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 199: s_objet_resultat) == d_erreur)
! 200: {
! 201: return;
! 202: }
! 203:
! 204: return;
! 205: }
! 206:
! 207:
! 208: /*
! 209: ================================================================================
! 210: Fonction 'corr'
! 211: ================================================================================
! 212: Entrées :
! 213: --------------------------------------------------------------------------------
! 214: Sorties :
! 215: --------------------------------------------------------------------------------
! 216: Effets de bord : néant
! 217: ================================================================================
! 218: */
! 219:
! 220: void
! 221: instruction_corr(struct_processus *s_etat_processus)
! 222: {
! 223: logical1 erreur;
! 224: logical1 presence_variable;
! 225:
! 226: long i;
! 227:
! 228: struct_objet *s_objet_statistique;
! 229: struct_objet *s_objet_resultat;
! 230:
! 231: unsigned long nombre_colonnes;
! 232:
! 233: (*s_etat_processus).erreur_execution = d_ex;
! 234:
! 235: if ((*s_etat_processus).affichage_arguments == 'Y')
! 236: {
! 237: printf("\n CORR ");
! 238:
! 239: if ((*s_etat_processus).langue == 'F')
! 240: {
! 241: printf("(corrélation)\n\n");
! 242: }
! 243: else
! 244: {
! 245: printf("(correlation)\n\n");
! 246: }
! 247:
! 248: printf("-> 1: %s\n", d_REL);
! 249:
! 250: return;
! 251: }
! 252: else if ((*s_etat_processus).test_instruction == 'Y')
! 253: {
! 254: (*s_etat_processus).nombre_arguments = -1;
! 255: return;
! 256: }
! 257:
! 258: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 259: {
! 260: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
! 261: {
! 262: return;
! 263: }
! 264: }
! 265:
! 266: /*
! 267: * Recherche d'une variable globale référencée par SIGMA
! 268: */
! 269:
! 270: if (recherche_variable(s_etat_processus, ds_sdat) == d_faux)
! 271: {
! 272: /*
! 273: * Aucune variable SIGMA
! 274: */
! 275:
! 276: (*s_etat_processus).erreur_systeme = d_es;
! 277: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 278: return;
! 279: }
! 280: else
! 281: {
! 282: /*
! 283: * Il existe une variable locale SIGMA. Reste à vérifier l'existence
! 284: * d'une variable SIGMA globale...
! 285: */
! 286:
! 287: i = (*s_etat_processus).position_variable_courante;
! 288: presence_variable = d_faux;
! 289:
! 290: while(i >= 0)
! 291: {
! 292: if ((strcmp((*s_etat_processus).s_liste_variables[i].nom,
! 293: ds_sdat) == 0) && ((*s_etat_processus)
! 294: .s_liste_variables[i].niveau == 1))
! 295: {
! 296: presence_variable = d_vrai;
! 297: break;
! 298: }
! 299:
! 300: i--;
! 301: }
! 302:
! 303: if (presence_variable == d_faux)
! 304: {
! 305: (*s_etat_processus).erreur_execution = d_ex_absence_observations;
! 306: return;
! 307: }
! 308: else
! 309: {
! 310: (*s_etat_processus).position_variable_courante = i;
! 311:
! 312: if ((*s_etat_processus).s_liste_variables
! 313: [(*s_etat_processus).position_variable_courante].objet
! 314: == NULL)
! 315: {
! 316: (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
! 317: return;
! 318: }
! 319:
! 320: if (((*((*s_etat_processus).s_liste_variables
! 321: [(*s_etat_processus).position_variable_courante].objet))
! 322: .type != MIN) && ((*((*s_etat_processus)
! 323: .s_liste_variables[(*s_etat_processus)
! 324: .position_variable_courante].objet)).type != MRL))
! 325: {
! 326: (*s_etat_processus).erreur_execution =
! 327: d_ex_matrice_statistique_invalide;
! 328: return;
! 329: }
! 330:
! 331: nombre_colonnes = (*((struct_matrice *) (*((*s_etat_processus)
! 332: .s_liste_variables[(*s_etat_processus)
! 333: .position_variable_courante].objet)).objet))
! 334: .nombre_colonnes;
! 335: }
! 336: }
! 337:
! 338: s_objet_statistique = ((*s_etat_processus).s_liste_variables
! 339: [(*s_etat_processus).position_variable_courante]).objet;
! 340:
! 341: if (((*s_objet_statistique).type == MIN) ||
! 342: ((*s_objet_statistique).type == MRL))
! 343: {
! 344: if (((*s_etat_processus).colonne_statistique_1 < 1) ||
! 345: ((*s_etat_processus).colonne_statistique_2 < 1) ||
! 346: ((*s_etat_processus).colonne_statistique_1 > (long)
! 347: nombre_colonnes) || ((*s_etat_processus).colonne_statistique_2
! 348: > (long) nombre_colonnes))
! 349: {
! 350: (*s_etat_processus).erreur_execution =
! 351: d_ex_observations_inexistantes;
! 352: return;
! 353: }
! 354:
! 355: if ((s_objet_resultat = allocation(s_etat_processus, REL))
! 356: == NULL)
! 357: {
! 358: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 359: return;
! 360: }
! 361:
! 362: (*((real8 *) (*s_objet_resultat).objet)) = correlation_statistique(
! 363: (struct_matrice *) (*s_objet_statistique).objet,
! 364: (*s_etat_processus).colonne_statistique_1,
! 365: (*s_etat_processus).colonne_statistique_2, &erreur);
! 366:
! 367: if (erreur == d_erreur)
! 368: {
! 369: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 370: return;
! 371: }
! 372: }
! 373: else
! 374: {
! 375: (*s_etat_processus).erreur_execution =
! 376: d_ex_matrice_statistique_invalide;
! 377: return;
! 378: }
! 379:
! 380: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 381: s_objet_resultat) == d_erreur)
! 382: {
! 383: return;
! 384: }
! 385:
! 386: return;
! 387: }
! 388:
! 389:
! 390: /*
! 391: ================================================================================
! 392: Fonction 'copyright'
! 393: ================================================================================
! 394: Entrées :
! 395: --------------------------------------------------------------------------------
! 396: Sorties :
! 397: --------------------------------------------------------------------------------
! 398: Effets de bord : néant
! 399: ================================================================================
! 400: */
! 401:
! 402: void
! 403: instruction_copyright(struct_processus *s_etat_processus)
! 404: {
! 405: # include "copyright.conv.h"
! 406:
! 407: (*s_etat_processus).erreur_execution = d_ex;
! 408:
! 409: if ((*s_etat_processus).affichage_arguments == 'Y')
! 410: {
! 411: printf("\n COPYRIGHT ");
! 412:
! 413: if ((*s_etat_processus).langue == 'F')
! 414: {
! 415: printf("(copyright)\n\n");
! 416: printf(" Aucun argument\n");
! 417: }
! 418: else
! 419: {
! 420: printf("(copyright)\n\n");
! 421: printf(" No argument\n");
! 422: }
! 423:
! 424: return;
! 425: }
! 426: else if ((*s_etat_processus).test_instruction == 'Y')
! 427: {
! 428: (*s_etat_processus).nombre_arguments = -1;
! 429: return;
! 430: }
! 431:
! 432: printf("\n RPL/2 (R) version %s\n", d_version_rpl);
! 433: printf("%s\n", ((*s_etat_processus).langue == 'F' )
! 434: ? copyright : copyright_anglais);
! 435:
! 436: if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
! 437: {
! 438: printf("\n");
! 439: }
! 440:
! 441: return;
! 442: }
! 443:
! 444:
! 445: /*
! 446: ================================================================================
! 447: Fonction 'convert'
! 448: ================================================================================
! 449: Entrées :
! 450: --------------------------------------------------------------------------------
! 451: Sorties :
! 452: --------------------------------------------------------------------------------
! 453: Effets de bord : néant
! 454: ================================================================================
! 455: */
! 456:
! 457: void
! 458: instruction_convert(struct_processus *s_etat_processus)
! 459: {
! 460: file *pipe;
! 461:
! 462: int fin_fichier;
! 463:
! 464: logical1 last_valide;
! 465:
! 466: long longueur_chaine;
! 467:
! 468: logical1 presence_resultat;
! 469:
! 470: struct_objet *s_objet_argument_1;
! 471: struct_objet *s_objet_argument_2;
! 472: struct_objet *s_objet_argument_3;
! 473:
! 474: unsigned char *commande;
! 475: unsigned char ligne[1024 + 1];
! 476: unsigned char *tampon_instruction;
! 477:
! 478: (*s_etat_processus).erreur_execution = d_ex;
! 479:
! 480: if ((*s_etat_processus).affichage_arguments == 'Y')
! 481: {
! 482: printf("\n CONVERT ");
! 483:
! 484: if ((*s_etat_processus).langue == 'F')
! 485: {
! 486: printf("(conversion d'unités)\n\n");
! 487: }
! 488: else
! 489: {
! 490: printf("(units conversion)\n\n");
! 491: }
! 492:
! 493: printf(" 3: %s, %s\n", d_INT, d_REL);
! 494: printf(" 2: %s\n", d_CHN);
! 495: printf(" 1: %s\n", d_CHN);
! 496: printf("-> 2: %s, %s\n", d_INT, d_REL);
! 497: printf(" 1: %s\n", d_CHN);
! 498:
! 499: return;
! 500: }
! 501: else if ((*s_etat_processus).test_instruction == 'Y')
! 502: {
! 503: (*s_etat_processus).nombre_arguments = -1;
! 504: return;
! 505: }
! 506:
! 507: if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
! 508: {
! 509: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
! 510: {
! 511: return;
! 512: }
! 513: }
! 514:
! 515: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 516: &s_objet_argument_1) == d_erreur)
! 517: {
! 518: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 519: return;
! 520: }
! 521:
! 522: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 523: &s_objet_argument_2) == d_erreur)
! 524: {
! 525: liberation(s_etat_processus, s_objet_argument_1);
! 526:
! 527: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 528: return;
! 529: }
! 530:
! 531: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 532: &s_objet_argument_3) == d_erreur)
! 533: {
! 534: liberation(s_etat_processus, s_objet_argument_1);
! 535: liberation(s_etat_processus, s_objet_argument_2);
! 536:
! 537: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 538: return;
! 539: }
! 540:
! 541: if (((*s_objet_argument_1).type == CHN) &&
! 542: ((*s_objet_argument_2).type == CHN) &&
! 543: (((*s_objet_argument_3).type == INT) ||
! 544: ((*s_objet_argument_3).type == REL)))
! 545: {
! 546: longueur_chaine = strlen(ds_rplconvert_commande) - 9
! 547: + strlen((unsigned char *) (*s_objet_argument_1).objet)
! 548: + strlen((unsigned char *) (*s_objet_argument_2).objet)
! 549: + (2 * strlen(d_exec_path));
! 550:
! 551: if ((commande = malloc((longueur_chaine + 1) * sizeof(unsigned char)))
! 552: == NULL)
! 553: {
! 554: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 555: return;
! 556: }
! 557:
! 558: sprintf(commande, ds_rplconvert_commande, d_exec_path, d_exec_path,
! 559: (unsigned char *) (*s_objet_argument_2).objet,
! 560: (unsigned char *) (*s_objet_argument_1).objet);
! 561:
! 562: if ((pipe = popen(commande, "r")) == NULL)
! 563: {
! 564: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 565: return;
! 566: }
! 567:
! 568: free(commande);
! 569:
! 570: presence_resultat = d_faux;
! 571:
! 572: do
! 573: {
! 574: fin_fichier = fscanf(pipe, "%1024s", ligne);
! 575:
! 576: if (strcmp(ligne, "*") == 0)
! 577: {
! 578: fin_fichier = fscanf(pipe, "%1024s", ligne);
! 579:
! 580: if (fin_fichier != EOF)
! 581: {
! 582: presence_resultat = d_vrai;
! 583:
! 584: tampon_instruction =
! 585: (*s_etat_processus).instruction_courante;
! 586: (*s_etat_processus).instruction_courante = ligne;
! 587:
! 588: recherche_type(s_etat_processus);
! 589:
! 590: (*s_etat_processus).instruction_courante =
! 591: tampon_instruction;
! 592:
! 593: if ((*s_etat_processus).erreur_execution != d_ex)
! 594: {
! 595: if (pclose(pipe) == -1)
! 596: {
! 597: (*s_etat_processus).erreur_systeme = d_es_processus;
! 598: return;
! 599: }
! 600:
! 601: liberation(s_etat_processus, s_objet_argument_1);
! 602: liberation(s_etat_processus, s_objet_argument_2);
! 603: liberation(s_etat_processus, s_objet_argument_3);
! 604:
! 605: return;
! 606: }
! 607: }
! 608: }
! 609: } while(fin_fichier != EOF);
! 610:
! 611: /*
! 612: * Récupération de la ligne renvoyée commencant par "*". Si une telle
! 613: * ligne n'existe par, rplconvert retourne une erreur de type
! 614: * « conformability error » ou « Unknown unit ».
! 615: */
! 616:
! 617: if (pclose(pipe) == -1)
! 618: {
! 619: (*s_etat_processus).erreur_systeme = d_es_processus;
! 620: return;
! 621: }
! 622:
! 623: if (presence_resultat == d_faux)
! 624: {
! 625: liberation(s_etat_processus, s_objet_argument_1);
! 626: liberation(s_etat_processus, s_objet_argument_2);
! 627: liberation(s_etat_processus, s_objet_argument_3);
! 628:
! 629: (*s_etat_processus).erreur_execution = d_ex_conversion_unite;
! 630: return;
! 631: }
! 632:
! 633: /*
! 634: * Retrait des espaces dans la chaîne unité renvoyée
! 635: */
! 636:
! 637: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 638: s_objet_argument_3) == d_erreur)
! 639: {
! 640: return;
! 641: }
! 642:
! 643: if (last_valide == d_vrai)
! 644: {
! 645: cf(s_etat_processus, 31);
! 646: }
! 647:
! 648: instruction_multiplication(s_etat_processus);
! 649:
! 650: if (last_valide == d_vrai)
! 651: {
! 652: sf(s_etat_processus, 31);
! 653: }
! 654: }
! 655: else
! 656: {
! 657: liberation(s_etat_processus, s_objet_argument_1);
! 658: liberation(s_etat_processus, s_objet_argument_2);
! 659: liberation(s_etat_processus, s_objet_argument_3);
! 660:
! 661: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 662: return;
! 663: }
! 664:
! 665: liberation(s_etat_processus, s_objet_argument_1);
! 666: liberation(s_etat_processus, s_objet_argument_2);
! 667:
! 668: return;
! 669: }
! 670:
! 671:
! 672: /*
! 673: ================================================================================
! 674: Fonction 'close'
! 675: ================================================================================
! 676: Entrées :
! 677: --------------------------------------------------------------------------------
! 678: Sorties :
! 679: --------------------------------------------------------------------------------
! 680: Effets de bord : néant
! 681: ================================================================================
! 682: */
! 683:
! 684: void
! 685: instruction_close(struct_processus *s_etat_processus)
! 686: {
! 687: file *descripteur;
! 688:
! 689: int socket;
! 690:
! 691: logical1 socket_connectee;
! 692:
! 693: struct_liste_chainee *l_element_courant;
! 694: struct_liste_chainee *l_element_precedent;
! 695:
! 696: struct_objet *s_objet_argument;
! 697:
! 698: (*s_etat_processus).erreur_execution = d_ex;
! 699:
! 700: if ((*s_etat_processus).affichage_arguments == 'Y')
! 701: {
! 702: printf("\n CLOSE ");
! 703:
! 704: if ((*s_etat_processus).langue == 'F')
! 705: {
! 706: printf("(fermeture d'un fichier, d'une socket ou d'un sémaphore)"
! 707: "\n\n");
! 708: }
! 709: else
! 710: {
! 711: printf("(close file, socket or semaphore)\n\n");
! 712: }
! 713:
! 714: printf(" 1: %s\n\n", d_FCH);
! 715:
! 716: printf(" 1: %s\n\n", d_SCK);
! 717:
! 718: printf(" 1: %s\n", d_SPH);
! 719:
! 720: return;
! 721: }
! 722: else if ((*s_etat_processus).test_instruction == 'Y')
! 723: {
! 724: (*s_etat_processus).nombre_arguments = -1;
! 725: return;
! 726: }
! 727:
! 728: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 729: {
! 730: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 731: {
! 732: return;
! 733: }
! 734: }
! 735:
! 736: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 737: &s_objet_argument) == d_erreur)
! 738: {
! 739: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 740: return;
! 741: }
! 742:
! 743: if ((*s_objet_argument).type == FCH)
! 744: {
! 745: /*
! 746: * Retrait du descripteur de la pile de fichiers
! 747: */
! 748:
! 749: l_element_courant = (*s_etat_processus).s_fichiers;
! 750: l_element_precedent = NULL;
! 751:
! 752: descripteur = NULL;
! 753:
! 754: while(l_element_courant != NULL)
! 755: {
! 756: if (((*((struct_descripteur_fichier *) (*l_element_courant).donnee))
! 757: .identifiant == (*((struct_fichier *) (*s_objet_argument)
! 758: .objet)).descripteur) && ((*((struct_descripteur_fichier *)
! 759: (*l_element_courant).donnee)).pid == getpid()) &&
! 760: (pthread_equal((*((struct_descripteur_fichier *)
! 761: (*l_element_courant).donnee)).tid, pthread_self()) != 0))
! 762: {
! 763: if (((*((struct_fichier *) (*s_objet_argument).objet)).pid ==
! 764: (*((struct_descripteur_fichier *) (*l_element_courant)
! 765: .donnee)).pid) && (pthread_equal((*((struct_fichier *)
! 766: (*s_objet_argument).objet)).tid,
! 767: (*((struct_descripteur_fichier *) (*l_element_courant)
! 768: .donnee)).tid) != 0))
! 769: {
! 770: descripteur = (*((struct_descripteur_fichier *)
! 771: (*l_element_courant).donnee)).descripteur;
! 772:
! 773: if (l_element_precedent == NULL)
! 774: {
! 775: (*s_etat_processus).s_fichiers =
! 776: (*l_element_courant).suivant;
! 777: }
! 778: else if ((*l_element_courant).suivant == NULL)
! 779: {
! 780: (*l_element_precedent).suivant = NULL;
! 781: }
! 782: else
! 783: {
! 784: (*l_element_precedent).suivant =
! 785: (*l_element_courant).suivant;
! 786: }
! 787:
! 788: free((*((struct_descripteur_fichier *)
! 789: (*l_element_courant).donnee)).nom);
! 790: free((*l_element_courant).donnee);
! 791: free(l_element_courant);
! 792:
! 793: break;
! 794: }
! 795: }
! 796:
! 797: l_element_precedent = l_element_courant;
! 798: l_element_courant = (*l_element_courant).suivant;
! 799: }
! 800:
! 801: if (descripteur == NULL)
! 802: {
! 803: liberation(s_etat_processus, s_objet_argument);
! 804:
! 805: (*s_etat_processus).erreur_execution = d_ex_erreur_acces_fichier;
! 806: return;
! 807: }
! 808:
! 809: /*
! 810: * Fermeture du fichier
! 811: */
! 812:
! 813: if (fclose(descripteur) != 0)
! 814: {
! 815: liberation(s_etat_processus, s_objet_argument);
! 816:
! 817: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 818: return;
! 819: }
! 820:
! 821: if ((*((struct_fichier *) (*s_objet_argument).objet)).ouverture == 'S')
! 822: {
! 823: if (destruction_fichier((*((struct_fichier *)
! 824: (*s_objet_argument).objet)).nom) == d_erreur)
! 825: {
! 826: liberation(s_etat_processus, s_objet_argument);
! 827:
! 828: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 829: return;
! 830: }
! 831: }
! 832: }
! 833: else if ((*s_objet_argument).type == SCK)
! 834: {
! 835: /*
! 836: * Retrait de la socket de la pile
! 837: */
! 838:
! 839: l_element_courant = (*s_etat_processus).s_sockets;
! 840: l_element_precedent = NULL;
! 841:
! 842: socket = -1;
! 843: socket_connectee = d_faux;
! 844:
! 845: while(l_element_courant != NULL)
! 846: {
! 847: if ((*((struct_socket *) (*(*l_element_courant).donnee).objet))
! 848: .socket == (*((struct_socket *) (*s_objet_argument)
! 849: .objet)).socket)
! 850: {
! 851: socket = (*((struct_socket *)
! 852: (*(*l_element_courant).donnee).objet)).socket;
! 853: socket_connectee = (*((struct_socket *)
! 854: (*(*l_element_courant).donnee).objet)).socket_connectee;
! 855:
! 856: if (l_element_precedent == NULL)
! 857: {
! 858: (*s_etat_processus).s_sockets =
! 859: (*l_element_courant).suivant;
! 860: }
! 861: else if ((*l_element_courant).suivant == NULL)
! 862: {
! 863: (*l_element_precedent).suivant = NULL;
! 864: }
! 865: else
! 866: {
! 867: (*l_element_precedent).suivant =
! 868: (*l_element_courant).suivant;
! 869: }
! 870:
! 871: liberation(s_etat_processus, (*l_element_courant).donnee);
! 872: free(l_element_courant);
! 873:
! 874: break;
! 875: }
! 876:
! 877: l_element_precedent = l_element_courant;
! 878: l_element_courant = (*l_element_courant).suivant;
! 879: }
! 880:
! 881: if (socket == -1)
! 882: {
! 883: liberation(s_etat_processus, s_objet_argument);
! 884:
! 885: (*s_etat_processus).erreur_execution = d_ex_erreur_acces_fichier;
! 886: return;
! 887: }
! 888:
! 889: /*
! 890: * Fermeture de la socket
! 891: */
! 892:
! 893: if (socket_connectee == d_vrai)
! 894: {
! 895: shutdown(socket, SHUT_RDWR);
! 896: }
! 897:
! 898: if (close(socket) != 0)
! 899: {
! 900: liberation(s_etat_processus, s_objet_argument);
! 901:
! 902: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
! 903: return;
! 904: }
! 905:
! 906: if ((*((struct_socket *) (*s_objet_argument).objet)).effacement == 'Y')
! 907: {
! 908: unlink((*((struct_socket *) (*s_objet_argument).objet)).adresse);
! 909: }
! 910: }
! 911: else if ((*s_objet_argument).type == SPH)
! 912: {
! 913: if (sem_close((*((struct_semaphore *) (*s_objet_argument).objet))
! 914: .semaphore) != 0)
! 915: {
! 916: (*s_etat_processus).erreur_execution = d_ex_semaphore;
! 917: return;
! 918: }
! 919: }
! 920: else
! 921: {
! 922: liberation(s_etat_processus, s_objet_argument);
! 923:
! 924: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 925: return;
! 926: }
! 927:
! 928: liberation(s_etat_processus, s_objet_argument);
! 929:
! 930: return;
! 931: }
! 932:
! 933:
! 934: /*
! 935: ================================================================================
! 936: Fonction 'create'
! 937: ================================================================================
! 938: Entrées :
! 939: --------------------------------------------------------------------------------
! 940: Sorties :
! 941: --------------------------------------------------------------------------------
! 942: Effets de bord : néant
! 943: ================================================================================
! 944: */
! 945:
! 946: void
! 947: instruction_create(struct_processus *s_etat_processus)
! 948: {
! 949: file *fichier;
! 950:
! 951: logical1 erreur;
! 952: logical1 existence;
! 953: logical1 ouverture;
! 954:
! 955: struct_objet *s_objet_argument;
! 956:
! 957: unsigned long unite;
! 958:
! 959: (*s_etat_processus).erreur_execution = d_ex;
! 960:
! 961: if ((*s_etat_processus).affichage_arguments == 'Y')
! 962: {
! 963: printf("\n CREATE ");
! 964:
! 965: if ((*s_etat_processus).langue == 'F')
! 966: {
! 967: printf("(création d'un fichier)\n\n");
! 968: }
! 969: else
! 970: {
! 971: printf("(create file)\n\n");
! 972: }
! 973:
! 974: printf(" 1: %s\n", d_CHN);
! 975:
! 976: return;
! 977: }
! 978: else if ((*s_etat_processus).test_instruction == 'Y')
! 979: {
! 980: (*s_etat_processus).nombre_arguments = -1;
! 981: return;
! 982: }
! 983:
! 984: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 985: {
! 986: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
! 987: {
! 988: return;
! 989: }
! 990: }
! 991:
! 992: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 993: &s_objet_argument) == d_erreur)
! 994: {
! 995: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 996: return;
! 997: }
! 998:
! 999: if ((*s_objet_argument).type == CHN)
! 1000: {
! 1001: erreur = caracteristiques_fichier(s_etat_processus, (unsigned char *)
! 1002: (*s_objet_argument).objet, &existence, &ouverture, &unite);
! 1003:
! 1004: if ((erreur != d_absence_erreur) || (existence == d_vrai))
! 1005: {
! 1006: liberation(s_etat_processus, s_objet_argument);
! 1007:
! 1008: (*s_etat_processus).erreur_execution =
! 1009: d_ex_erreur_acces_fichier;
! 1010: return;
! 1011: }
! 1012:
! 1013: if ((fichier = fopen((unsigned char *) (*s_objet_argument).objet, "w"))
! 1014: == NULL)
! 1015: {
! 1016: liberation(s_etat_processus, s_objet_argument);
! 1017:
! 1018: (*s_etat_processus).erreur_execution =
! 1019: d_ex_erreur_acces_fichier;
! 1020: return;
! 1021: }
! 1022:
! 1023: if (fclose(fichier) != 0)
! 1024: {
! 1025: liberation(s_etat_processus, s_objet_argument);
! 1026:
! 1027: (*s_etat_processus).erreur_execution =
! 1028: d_ex_erreur_acces_fichier;
! 1029: return;
! 1030: }
! 1031: }
! 1032: else
! 1033: {
! 1034: liberation(s_etat_processus, s_objet_argument);
! 1035:
! 1036: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1037: return;
! 1038: }
! 1039:
! 1040: liberation(s_etat_processus, s_objet_argument);
! 1041:
! 1042: return;
! 1043: }
! 1044:
! 1045:
! 1046: /*
! 1047: ================================================================================
! 1048: Fonction 'cswp'
! 1049: ================================================================================
! 1050: Entrées :
! 1051: --------------------------------------------------------------------------------
! 1052: Sorties :
! 1053: --------------------------------------------------------------------------------
! 1054: Effets de bord : néant
! 1055: ================================================================================
! 1056: */
! 1057:
! 1058: void
! 1059: instruction_cswp(struct_processus *s_etat_processus)
! 1060: {
! 1061: struct_objet *s_copie_argument_3;
! 1062: struct_objet *s_objet_argument_1;
! 1063: struct_objet *s_objet_argument_2;
! 1064: struct_objet *s_objet_argument_3;
! 1065:
! 1066: signed long colonne_1;
! 1067: signed long colonne_2;
! 1068:
! 1069: unsigned long i;
! 1070:
! 1071: (*s_etat_processus).erreur_execution = d_ex;
! 1072:
! 1073: if ((*s_etat_processus).affichage_arguments == 'Y')
! 1074: {
! 1075: printf("\n CSWP ");
! 1076:
! 1077: if ((*s_etat_processus).langue == 'F')
! 1078: {
! 1079: printf("(échange de deux colonnes d'une matrice)\n\n");
! 1080: }
! 1081: else
! 1082: {
! 1083: printf("(swap two columns of a matrix)\n\n");
! 1084: }
! 1085:
! 1086: printf(" 3: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1087: printf(" 2: %s\n", d_INT);
! 1088: printf(" 1: %s\n", d_INT);
! 1089: printf("-> 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
! 1090:
! 1091: return;
! 1092: }
! 1093: else if ((*s_etat_processus).test_instruction == 'Y')
! 1094: {
! 1095: (*s_etat_processus).nombre_arguments = -1;
! 1096: return;
! 1097: }
! 1098:
! 1099: if (test_cfsf(s_etat_processus, 31) == d_vrai)
! 1100: {
! 1101: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
! 1102: {
! 1103: return;
! 1104: }
! 1105: }
! 1106:
! 1107: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1108: &s_objet_argument_1) == d_erreur)
! 1109: {
! 1110: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1111: return;
! 1112: }
! 1113:
! 1114: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1115: &s_objet_argument_2) == d_erreur)
! 1116: {
! 1117: liberation(s_etat_processus, s_objet_argument_1);
! 1118:
! 1119: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1120: return;
! 1121: }
! 1122:
! 1123: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1124: &s_objet_argument_3) == d_erreur)
! 1125: {
! 1126: liberation(s_etat_processus, s_objet_argument_1);
! 1127: liberation(s_etat_processus, s_objet_argument_2);
! 1128:
! 1129: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
! 1130: return;
! 1131: }
! 1132:
! 1133: if (((*s_objet_argument_1).type == INT) &&
! 1134: ((*s_objet_argument_2).type == INT))
! 1135: {
! 1136: colonne_1 = (*((integer8 *) (*s_objet_argument_1).objet)) - 1;
! 1137: colonne_2 = (*((integer8 *) (*s_objet_argument_2).objet)) - 1;
! 1138:
! 1139: if ((*s_objet_argument_3).type == MIN)
! 1140: {
! 1141: if ((colonne_1 < 0) || (colonne_1 > ((signed long)
! 1142: (*((struct_matrice *) (*s_objet_argument_3).objet))
! 1143: .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
! 1144: ((signed long) (*((struct_matrice *)
! 1145: (*s_objet_argument_3).objet)).nombre_colonnes) - 1))
! 1146: {
! 1147: liberation(s_etat_processus, s_objet_argument_1);
! 1148: liberation(s_etat_processus, s_objet_argument_2);
! 1149: liberation(s_etat_processus, s_objet_argument_3);
! 1150:
! 1151: (*s_etat_processus).erreur_execution =
! 1152: d_ex_dimensions_invalides;
! 1153: return;
! 1154: }
! 1155:
! 1156: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
! 1157: s_objet_argument_3, 'Q')) == NULL)
! 1158: {
! 1159: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1160: return;
! 1161: }
! 1162:
! 1163: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
! 1164: .nombre_lignes; i++)
! 1165: {
! 1166: ((integer8 **) (*((struct_matrice *)
! 1167: (*s_copie_argument_3).objet)).tableau)
! 1168: [i][colonne_1] = ((integer8 **) (*((struct_matrice *)
! 1169: (*s_objet_argument_3).objet)).tableau)[i][colonne_2];
! 1170: ((integer8 **) (*((struct_matrice *)
! 1171: (*s_copie_argument_3).objet)).tableau)
! 1172: [i][colonne_2] = ((integer8 **) (*((struct_matrice *)
! 1173: (*s_objet_argument_3).objet)).tableau)[i][colonne_1];
! 1174: }
! 1175: }
! 1176: else if ((*s_objet_argument_3).type == MRL)
! 1177: {
! 1178: if ((colonne_1 < 0) || (colonne_1 > ((signed long)
! 1179: (*((struct_matrice *) (*s_objet_argument_3).objet))
! 1180: .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
! 1181: ((signed long) (*((struct_matrice *)
! 1182: (*s_objet_argument_3).objet)).nombre_colonnes) - 1))
! 1183: {
! 1184: liberation(s_etat_processus, s_objet_argument_1);
! 1185: liberation(s_etat_processus, s_objet_argument_2);
! 1186: liberation(s_etat_processus, s_objet_argument_3);
! 1187:
! 1188: (*s_etat_processus).erreur_execution =
! 1189: d_ex_dimensions_invalides;
! 1190: return;
! 1191: }
! 1192:
! 1193: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
! 1194: s_objet_argument_3, 'O')) == NULL)
! 1195: {
! 1196: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1197: return;
! 1198: }
! 1199:
! 1200: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
! 1201: .nombre_lignes; i++)
! 1202: {
! 1203: ((real8 **) (*((struct_matrice *)
! 1204: (*s_copie_argument_3).objet)).tableau)
! 1205: [i][colonne_1] = ((real8 **) (*((struct_matrice *)
! 1206: (*s_objet_argument_3).objet)).tableau)[i][colonne_2];
! 1207: ((real8 **) (*((struct_matrice *)
! 1208: (*s_copie_argument_3).objet)).tableau)
! 1209: [i][colonne_2] = ((real8 **) (*((struct_matrice *)
! 1210: (*s_objet_argument_3).objet)).tableau)[i][colonne_1];
! 1211: }
! 1212: }
! 1213: else if ((*s_objet_argument_3).type == MCX)
! 1214: {
! 1215: if ((colonne_1 < 0) || (colonne_1 > ((signed long)
! 1216: (*((struct_matrice *) (*s_objet_argument_3).objet))
! 1217: .nombre_colonnes) - 1) || (colonne_2 < 0) || (colonne_2 >
! 1218: ((signed long) (*((struct_matrice *)
! 1219: (*s_objet_argument_3).objet)).nombre_colonnes) - 1))
! 1220: {
! 1221: liberation(s_etat_processus, s_objet_argument_1);
! 1222: liberation(s_etat_processus, s_objet_argument_2);
! 1223: liberation(s_etat_processus, s_objet_argument_3);
! 1224:
! 1225: (*s_etat_processus).erreur_execution =
! 1226: d_ex_dimensions_invalides;
! 1227: return;
! 1228: }
! 1229:
! 1230: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
! 1231: s_objet_argument_3, 'O')) == NULL)
! 1232: {
! 1233: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
! 1234: return;
! 1235: }
! 1236:
! 1237: for(i = 0; i < (*((struct_matrice *) (*s_objet_argument_3).objet))
! 1238: .nombre_lignes; i++)
! 1239: {
! 1240: ((complex16 **) (*((struct_matrice *)
! 1241: (*s_copie_argument_3).objet)).tableau)
! 1242: [i][colonne_1].partie_reelle =
! 1243: ((complex16 **) (*((struct_matrice *)
! 1244: (*s_objet_argument_3).objet)).tableau)[i][colonne_2]
! 1245: .partie_reelle;
! 1246: ((complex16 **) (*((struct_matrice *)
! 1247: (*s_copie_argument_3).objet)).tableau)
! 1248: [i][colonne_1].partie_imaginaire =
! 1249: ((complex16 **) (*((struct_matrice *)
! 1250: (*s_objet_argument_3).objet)).tableau)[i][colonne_2]
! 1251: .partie_imaginaire;
! 1252: ((complex16 **) (*((struct_matrice *)
! 1253: (*s_copie_argument_3).objet)).tableau)
! 1254: [i][colonne_2].partie_reelle =
! 1255: ((complex16 **) (*((struct_matrice *)
! 1256: (*s_objet_argument_3).objet)).tableau)[i][colonne_1]
! 1257: .partie_reelle;
! 1258: ((complex16 **) (*((struct_matrice *)
! 1259: (*s_copie_argument_3).objet)).tableau)
! 1260: [i][colonne_2].partie_imaginaire =
! 1261: ((complex16 **) (*((struct_matrice *)
! 1262: (*s_objet_argument_3).objet)).tableau)[i][colonne_1]
! 1263: .partie_imaginaire;
! 1264: }
! 1265: }
! 1266: else
! 1267: {
! 1268: liberation(s_etat_processus, s_objet_argument_1);
! 1269: liberation(s_etat_processus, s_objet_argument_2);
! 1270: liberation(s_etat_processus, s_objet_argument_3);
! 1271:
! 1272: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1273: return;
! 1274: }
! 1275: }
! 1276: else
! 1277: {
! 1278: liberation(s_etat_processus, s_objet_argument_1);
! 1279: liberation(s_etat_processus, s_objet_argument_2);
! 1280: liberation(s_etat_processus, s_objet_argument_3);
! 1281:
! 1282: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
! 1283: return;
! 1284: }
! 1285:
! 1286: liberation(s_etat_processus, s_objet_argument_1);
! 1287: liberation(s_etat_processus, s_objet_argument_2);
! 1288: liberation(s_etat_processus, s_objet_argument_3);
! 1289:
! 1290: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
! 1291: s_copie_argument_3) == d_erreur)
! 1292: {
! 1293: return;
! 1294: }
! 1295:
! 1296: return;
! 1297: }
! 1298:
! 1299: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_c4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src