File:  [local] / rpl / src / instructions_c4.c
Revision 1.4: download - view: text, annotated - select for diffs - revision graph
Thu Mar 4 10:17:50 2010 UTC (14 years, 2 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la version 4.0.12 !

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.12
    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>