File:  [local] / rpl / src / instructions_c4.c
Revision 1.66: download - view: text, annotated - select for diffs - revision graph
Thu Nov 26 11:44:34 2015 UTC (8 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_24, HEAD
Mise à jour de Lapack (3.6.0) et du numéro de version du RPL/2.

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

CVSweb interface <joel.bertrand@systella.fr>