File:  [local] / rpl / src / instructions_l4.c
Revision 1.67: download - view: text, annotated - select for diffs - revision graph
Fri Jan 10 11:15:46 2020 UTC (4 years, 3 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_32, HEAD
Modification du copyright.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.32
    4:   Copyright (C) 1989-2020 Dr. BERTRAND Joël
    5: 
    6:   This file is part of RPL/2.
    7: 
    8:   RPL/2 is free software; you can redistribute it and/or modify it
    9:   under the terms of the CeCILL V2 License as published by the french
   10:   CEA, CNRS and INRIA.
   11:  
   12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
   13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
   15:   for more details.
   16:  
   17:   You should have received a copy of the CeCILL License
   18:   along with RPL/2. If not, write to info@cecill.info.
   19: ================================================================================
   20: */
   21: 
   22: 
   23: #include "rpl-conv.h"
   24: 
   25: 
   26: /*
   27: ================================================================================
   28:   Fonction 'lu'
   29: ================================================================================
   30:   Entrées : pointeur sur une structure struct_processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_lu(struct_processus *s_etat_processus)
   40: {
   41:     struct_matrice              *s_matrice;
   42: 
   43:     struct_objet                *s_objet_argument;
   44:     struct_objet                *s_objet_copie;
   45:     struct_objet                *s_objet_resultat_1;
   46:     struct_objet                *s_objet_resultat_2;
   47:     struct_objet                *s_objet_resultat_3;
   48: 
   49:     integer8                    i;
   50:     integer8                    j;
   51: 
   52:     (*s_etat_processus).erreur_execution = d_ex;
   53: 
   54:     if ((*s_etat_processus).affichage_arguments == 'Y')
   55:     {
   56:         printf("\n  LU ");
   57:         
   58:         if ((*s_etat_processus).langue == 'F')
   59:         {
   60:             printf("(décomposition LU)\n\n");
   61:         }
   62:         else
   63:         {
   64:             printf("(LU decomposition)\n\n");
   65:         }
   66: 
   67:         printf("    1: %s, %s\n", d_MIN, d_MRL);
   68:         printf("->  3: %s\n", d_MIN);
   69:         printf("    2: %s\n", d_MRL);
   70:         printf("    1: %s\n\n", d_MRL);
   71: 
   72:         printf("    1: %s\n", d_MCX);
   73:         printf("->  3: %s\n", d_MIN);
   74:         printf("    2: %s\n", d_MCX);
   75:         printf("    1: %s\n", d_MCX);
   76: 
   77:         return;
   78:     }
   79:     else if ((*s_etat_processus).test_instruction == 'Y')
   80:     {
   81:         (*s_etat_processus).nombre_arguments = -1;
   82:         return;
   83:     }
   84: 
   85:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
   86:     {
   87:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
   88:         {
   89:             return;
   90:         }
   91:     }
   92: 
   93:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
   94:             &s_objet_argument) == d_erreur)
   95:     {
   96:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
   97:         return;
   98:     }
   99: 
  100: /*
  101: --------------------------------------------------------------------------------
  102:   Résultat sous la forme de matrices réelles
  103: --------------------------------------------------------------------------------
  104: */
  105: 
  106:     if (((*s_objet_argument).type == MIN) ||
  107:             ((*s_objet_argument).type == MRL))
  108:     {
  109:         if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
  110:                 (*((struct_matrice *) (*s_objet_argument).objet))
  111:                 .nombre_colonnes)
  112:         {
  113:             liberation(s_etat_processus, s_objet_argument);
  114: 
  115:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  116:             return;
  117:         }
  118: 
  119:         if ((s_objet_copie = copie_objet(s_etat_processus, s_objet_argument,
  120:                 'Q')) == NULL)
  121:         {
  122:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  123:             return;
  124:         }
  125: 
  126:         liberation(s_etat_processus, s_objet_argument);
  127:         s_objet_argument = s_objet_copie;
  128: 
  129:         if ((s_matrice = malloc(sizeof(struct_matrice))) == NULL)
  130:         {
  131:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  132:             return;
  133:         }
  134: 
  135:         factorisation_lu(s_etat_processus, (*s_objet_argument).objet,
  136:                 &s_matrice);
  137:         (*s_objet_copie).type = MRL;
  138: 
  139:         if (((*s_etat_processus).exception != d_ep) ||
  140:                 ((*s_etat_processus).erreur_execution != d_ex))
  141:         {
  142:             // S'il y a une erreur autre qu'une erreur système, le tableau
  143:             // de la structure matrice n'a pas encore été alloué.
  144: 
  145:             free(s_matrice);
  146:             liberation(s_etat_processus, s_objet_argument);
  147:             return;
  148:         }
  149: 
  150:         if ((*s_etat_processus).erreur_systeme != d_es)
  151:         {
  152:             return;
  153:         }
  154: 
  155:         if ((s_objet_resultat_1 = allocation(s_etat_processus, NON)) == NULL)
  156:         {
  157:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  158:             return;
  159:         }
  160: 
  161:         (*s_objet_resultat_1).objet = s_matrice;
  162:         (*s_objet_resultat_1).type = MIN;
  163: 
  164:         if ((s_objet_resultat_2 = allocation(s_etat_processus, MRL)) == NULL)
  165:         {
  166:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  167:             return;
  168:         }
  169: 
  170:         if ((s_objet_resultat_3 = allocation(s_etat_processus, MRL)) == NULL)
  171:         {
  172:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  173:             return;
  174:         }
  175: 
  176:         /* L */
  177: 
  178:         (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_lignes =
  179:                 (*((struct_matrice *) (*s_objet_argument).objet))
  180:                 .nombre_lignes;
  181:         (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_colonnes =
  182:                 (*((struct_matrice *) (*s_objet_argument).objet))
  183:                 .nombre_colonnes;
  184: 
  185:         if (((*((struct_matrice *) (*s_objet_resultat_3).objet)).tableau =
  186:                 malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_3)
  187:                 .objet)).nombre_lignes) * sizeof(real8 *))) == NULL)
  188:         {
  189:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  190:             return;
  191:         }
  192: 
  193:         for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_3).objet))
  194:                 .nombre_lignes; i++)
  195:         {
  196:             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_3).objet))
  197:                     .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
  198:                     (*s_objet_resultat_3).objet)).nombre_colonnes) *
  199:                     sizeof(real8))) == NULL)
  200:             {
  201:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  202:                 return;
  203:             }
  204: 
  205:             /*
  206:              * Si la décomposition comporte plus de lignes que de colonnes,
  207:              * L est une matrice trapézoïdale.
  208:              */
  209: 
  210:             for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_3).objet))
  211:                     .nombre_colonnes; j++)
  212:             {
  213:                 if (i == j)
  214:                 {
  215:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat_3)
  216:                             .objet)).tableau)[i][j] = 1;
  217:                 }
  218:                 else if (i > j)
  219:                 {
  220:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat_3)
  221:                             .objet)).tableau)[i][j] = ((real8 **)
  222:                             (*((struct_matrice *) (*s_objet_argument)
  223:                             .objet)).tableau)[i][j];
  224:                 }
  225:                 else
  226:                 {
  227:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat_3)
  228:                             .objet)).tableau)[i][j] = 0;
  229:                 }
  230:             }
  231:         }
  232: 
  233:         /* U */
  234: 
  235:         (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
  236:                 (*((struct_matrice *) (*s_objet_argument).objet))
  237:                 .nombre_lignes;
  238:         (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
  239:                 (*((struct_matrice *) (*s_objet_argument).objet))
  240:                 .nombre_colonnes;
  241: 
  242:         if (((*((struct_matrice *) (*s_objet_resultat_2).objet)).tableau =
  243:                 malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_2)
  244:                 .objet)).nombre_lignes) * sizeof(real8 *))) == NULL)
  245:         {
  246:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  247:             return;
  248:         }
  249: 
  250:         for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_2).objet))
  251:                 .nombre_lignes; i++)
  252:         {
  253:             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_2).objet))
  254:                     .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
  255:                     (*s_objet_resultat_2).objet)).nombre_colonnes) *
  256:                     sizeof(real8))) == NULL)
  257:             {
  258:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  259:                 return;
  260:             }
  261: 
  262:             /*
  263:              * Si la décomposition comporte plus de colonnes que de lignes,
  264:              * U est une matrice trapézoïdale.
  265:              */
  266: 
  267:             for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_2).objet))
  268:                     .nombre_colonnes; j++)
  269:             {
  270:                 if (i <= j)
  271:                 {
  272:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat_2)
  273:                             .objet)).tableau)[i][j] = ((real8 **)
  274:                             (*((struct_matrice *) (*s_objet_argument)
  275:                             .objet)).tableau)[i][j];
  276:                 }
  277:                 else
  278:                 {
  279:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat_2)
  280:                             .objet)).tableau)[i][j] = 0;
  281:                 }
  282:             }
  283:         }
  284:     }
  285: 
  286: /*
  287: --------------------------------------------------------------------------------
  288:   Résultat sous la forme de matrices complexes
  289: --------------------------------------------------------------------------------
  290: */
  291: 
  292:     else if ((*s_objet_argument).type == MCX)
  293:     {
  294:         if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
  295:                 (*((struct_matrice *) (*s_objet_argument).objet))
  296:                 .nombre_colonnes)
  297:         {
  298:             liberation(s_etat_processus, s_objet_argument);
  299: 
  300:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  301:             return;
  302:         }
  303: 
  304:         if ((s_objet_copie = copie_objet(s_etat_processus, s_objet_argument,
  305:                 'Q')) == NULL)
  306:         {
  307:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  308:             return;
  309:         }
  310: 
  311:         liberation(s_etat_processus, s_objet_argument);
  312:         s_objet_argument = s_objet_copie;
  313: 
  314:         if ((s_matrice = malloc(sizeof(struct_matrice))) == NULL)
  315:         {
  316:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  317:             return;
  318:         }
  319: 
  320:         factorisation_lu(s_etat_processus, (*s_objet_argument).objet,
  321:                 &s_matrice);
  322: 
  323:         if (((*s_etat_processus).exception != d_ep) ||
  324:                 ((*s_etat_processus).erreur_execution != d_ex))
  325:         {
  326:             // S'il y a une erreur autre qu'une erreur système, le tableau
  327:             // de la structure matrice n'a pas encore été alloué.
  328: 
  329:             free(s_matrice);
  330:             liberation(s_etat_processus, s_objet_argument);
  331:             return;
  332:         }
  333: 
  334:         if ((*s_etat_processus).erreur_systeme != d_es)
  335:         {
  336:             return;
  337:         }
  338: 
  339:         if ((s_objet_resultat_1 = allocation(s_etat_processus, NON)) == NULL)
  340:         {
  341:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  342:             return;
  343:         }
  344: 
  345:         (*s_objet_resultat_1).objet = s_matrice;
  346:         (*s_objet_resultat_1).type = MIN;
  347: 
  348:         if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX)) == NULL)
  349:         {
  350:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  351:             return;
  352:         }
  353: 
  354:         if ((s_objet_resultat_3 = allocation(s_etat_processus, MCX)) == NULL)
  355:         {
  356:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  357:             return;
  358:         }
  359: 
  360:         /* L */
  361: 
  362:         (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_lignes =
  363:                 (*((struct_matrice *) (*s_objet_argument).objet))
  364:                 .nombre_lignes;
  365:         (*((struct_matrice *) (*s_objet_resultat_3).objet)).nombre_colonnes =
  366:                 (*((struct_matrice *) (*s_objet_argument).objet))
  367:                 .nombre_colonnes;
  368: 
  369:         if (((*((struct_matrice *) (*s_objet_resultat_3).objet)).tableau =
  370:                 malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_3)
  371:                 .objet)).nombre_lignes) * sizeof(complex16 *))) == NULL)
  372:         {
  373:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  374:             return;
  375:         }
  376: 
  377:         for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_3).objet))
  378:                 .nombre_lignes; i++)
  379:         {
  380:             if ((((complex16 **) (*((struct_matrice *)
  381:                     (*s_objet_resultat_3).objet))
  382:                     .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
  383:                     (*s_objet_resultat_3).objet)).nombre_colonnes) *
  384:                     sizeof(complex16))) == NULL)
  385:             {
  386:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  387:                 return;
  388:             }
  389: 
  390:             /*
  391:              * Si la décomposition comporte plus de lignes que de colonnes,
  392:              * L est une matrice trapézoïdale.
  393:              */
  394: 
  395:             for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_3).objet))
  396:                     .nombre_colonnes; j++)
  397:             {
  398:                 if (i == j)
  399:                 {
  400:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
  401:                             .objet)).tableau)[i][j].partie_reelle = 1;
  402:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
  403:                             .objet)).tableau)[i][j].partie_imaginaire = 0;
  404:                 }
  405:                 else if (i > j)
  406:                 {
  407:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
  408:                             .objet)).tableau)[i][j] = ((complex16 **)
  409:                             (*((struct_matrice *) (*s_objet_argument)
  410:                             .objet)).tableau)[i][j];
  411:                 }
  412:                 else
  413:                 {
  414:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
  415:                             .objet)).tableau)[i][j].partie_reelle = 0;
  416:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_3)
  417:                             .objet)).tableau)[i][j].partie_imaginaire = 0;
  418:                 }
  419:             }
  420:         }
  421: 
  422:         /* U */
  423: 
  424:         (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
  425:                 (*((struct_matrice *) (*s_objet_argument).objet))
  426:                 .nombre_lignes;
  427:         (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
  428:                 (*((struct_matrice *) (*s_objet_argument).objet))
  429:                 .nombre_colonnes;
  430: 
  431:         if (((*((struct_matrice *) (*s_objet_resultat_2).objet)).tableau =
  432:                 malloc(((size_t) (*((struct_matrice *) (*s_objet_resultat_2)
  433:                 .objet)).nombre_lignes) * sizeof(complex16 *))) == NULL)
  434:         {
  435:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  436:             return;
  437:         }
  438: 
  439:         for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat_2).objet))
  440:                 .nombre_lignes; i++)
  441:         {
  442:             if ((((complex16 **) (*((struct_matrice *)
  443:                     (*s_objet_resultat_2).objet))
  444:                     .tableau)[i] = malloc(((size_t) (*((struct_matrice *)
  445:                     (*s_objet_resultat_2).objet)).nombre_colonnes) *
  446:                     sizeof(complex16))) == NULL)
  447:             {
  448:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  449:                 return;
  450:             }
  451: 
  452:             /*
  453:              * Si la décomposition comporte plus de colonnes que de lignes,
  454:              * U est une matrice trapézoïdale.
  455:              */
  456: 
  457:             for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat_2).objet))
  458:                     .nombre_colonnes; j++)
  459:             {
  460:                 if (i <= j)
  461:                 {
  462:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_2)
  463:                             .objet)).tableau)[i][j] = ((complex16 **)
  464:                             (*((struct_matrice *) (*s_objet_argument)
  465:                             .objet)).tableau)[i][j];
  466:                 }
  467:                 else
  468:                 {
  469:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_2)
  470:                             .objet)).tableau)[i][j].partie_reelle = 0;
  471:                     ((complex16 **) (*((struct_matrice *) (*s_objet_resultat_2)
  472:                             .objet)).tableau)[i][j].partie_imaginaire = 0;
  473:                 }
  474:             }
  475:         }
  476:     }
  477: 
  478: /*
  479: --------------------------------------------------------------------------------
  480:   Type d'argument invalide
  481: --------------------------------------------------------------------------------
  482: */
  483: 
  484:     else
  485:     {
  486:         liberation(s_etat_processus, s_objet_argument);
  487: 
  488:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  489:         return;
  490:     }
  491: 
  492:     liberation(s_etat_processus, s_objet_argument);
  493: 
  494:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  495:             s_objet_resultat_1) == d_erreur)
  496:     {
  497:         return;
  498:     }
  499: 
  500:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  501:             s_objet_resultat_3) == d_erreur)
  502:     {
  503:         return;
  504:     }
  505: 
  506:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  507:             s_objet_resultat_2) == d_erreur)
  508:     {
  509:         return;
  510:     }
  511: 
  512:     return;
  513: }
  514: 
  515: 
  516: /*
  517: ================================================================================
  518:   Fonction 'lchol'
  519: ================================================================================
  520:   Entrées : pointeur sur une structure struct_processus
  521: --------------------------------------------------------------------------------
  522:   Sorties :
  523: --------------------------------------------------------------------------------
  524:   Effets de bord : néant
  525: ================================================================================
  526: */
  527: 
  528: void
  529: instruction_lchol(struct_processus *s_etat_processus)
  530: {
  531:     struct_objet                *s_copie_objet;
  532:     struct_objet                *s_objet;
  533: 
  534:     (*s_etat_processus).erreur_execution = d_ex;
  535: 
  536:     if ((*s_etat_processus).affichage_arguments == 'Y')
  537:     {
  538:         printf("\n  LCHOL ");
  539:         
  540:         if ((*s_etat_processus).langue == 'F')
  541:         {
  542:             printf("(décomposition de Cholevski à gauche)\n\n");
  543:         }
  544:         else
  545:         {
  546:             printf("(left Cholevski decomposition)\n\n");
  547:         }
  548: 
  549:         printf("    1: %s, %s\n", d_MIN, d_MRL);
  550:         printf("->  1: %s\n\n", d_MRL);
  551: 
  552:         printf("    1: %s\n", d_MCX);
  553:         printf("->  1: %s\n", d_MCX);
  554: 
  555:         return;
  556:     }
  557:     else if ((*s_etat_processus).test_instruction == 'Y')
  558:     {
  559:         (*s_etat_processus).nombre_arguments = -1;
  560:         return;
  561:     }
  562: 
  563:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  564:     {
  565:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  566:         {
  567:             return;
  568:         }
  569:     }
  570: 
  571:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  572:             &s_objet) == d_erreur)
  573:     {
  574:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  575:         return;
  576:     }
  577: 
  578: /*
  579: --------------------------------------------------------------------------------
  580:   Résultat sous la forme de matrices réelles
  581: --------------------------------------------------------------------------------
  582: */
  583: 
  584:     if (((*s_objet).type == MIN) ||
  585:             ((*s_objet).type == MRL))
  586:     {
  587:         if ((*((struct_matrice *) (*s_objet).objet)).nombre_lignes !=
  588:                 (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes)
  589:         {
  590:             liberation(s_etat_processus, s_objet);
  591: 
  592:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  593:             return;
  594:         }
  595: 
  596:         if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'Q'))
  597:                 == NULL)
  598:         {
  599:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  600:             return;
  601:         }
  602: 
  603:         liberation(s_etat_processus, s_objet);
  604:         s_objet = s_copie_objet;
  605: 
  606:         factorisation_cholesky(s_etat_processus, (*s_objet).objet, 'L');
  607:         (*s_objet).type = MRL;
  608: 
  609:         if ((*s_etat_processus).erreur_systeme != d_es)
  610:         {
  611:             return;
  612:         }
  613: 
  614:         if (((*s_etat_processus).exception != d_ep) ||
  615:                 ((*s_etat_processus).erreur_execution != d_ex))
  616:         {
  617:             if ((*s_etat_processus).exception == d_ep_domaine_definition)
  618:             {
  619:                 (*s_etat_processus).exception =
  620:                         d_ep_matrice_non_definie_positive;
  621:             }
  622: 
  623:             liberation(s_etat_processus, s_objet);
  624:             return;
  625:         }
  626:     }
  627: 
  628: /*
  629: --------------------------------------------------------------------------------
  630:   Résultat sous la forme de matrices complexes
  631: --------------------------------------------------------------------------------
  632: */
  633: 
  634:     else if ((*s_objet).type == MCX)
  635:     {
  636:         if ((*((struct_matrice *) (*s_objet).objet)).nombre_lignes !=
  637:                 (*((struct_matrice *) (*s_objet).objet)).nombre_colonnes)
  638:         {
  639:             liberation(s_etat_processus, s_objet);
  640: 
  641:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  642:             return;
  643:         }
  644: 
  645:         if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'Q'))
  646:                 == NULL)
  647:         {
  648:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  649:             return;
  650:         }
  651: 
  652:         liberation(s_etat_processus, s_objet);
  653:         s_objet = s_copie_objet;
  654: 
  655:         factorisation_cholesky(s_etat_processus, (*s_objet).objet, 'L');
  656: 
  657:         if ((*s_etat_processus).erreur_systeme != d_es)
  658:         {
  659:             return;
  660:         }
  661: 
  662:         if (((*s_etat_processus).exception != d_ep) ||
  663:                 ((*s_etat_processus).erreur_execution != d_ex))
  664:         {
  665:             if ((*s_etat_processus).exception == d_ep_domaine_definition)
  666:             {
  667:                 (*s_etat_processus).exception =
  668:                         d_ep_matrice_non_definie_positive;
  669:             }
  670: 
  671:             liberation(s_etat_processus, s_objet);
  672:             return;
  673:         }
  674:     }
  675: 
  676: /*
  677: --------------------------------------------------------------------------------
  678:   Type d'argument invalide
  679: --------------------------------------------------------------------------------
  680: */
  681: 
  682:     else
  683:     {
  684:         liberation(s_etat_processus, s_objet);
  685: 
  686:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  687:         return;
  688:     }
  689: 
  690:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  691:             s_objet) == d_erreur)
  692:     {
  693:         return;
  694:     }
  695: 
  696:     return;
  697: }
  698: 
  699: 
  700: /*
  701: ================================================================================
  702:   Fonction 'lock'
  703: ================================================================================
  704:   Entrées : pointeur sur une structure struct_processus
  705: --------------------------------------------------------------------------------
  706:   Sorties :
  707: --------------------------------------------------------------------------------
  708:   Effets de bord : néant
  709: ================================================================================
  710: */
  711: 
  712: void
  713: instruction_lock(struct_processus *s_etat_processus)
  714: {
  715:     file                        *descripteur;
  716: 
  717:     struct flock                lock;
  718: 
  719:     struct_descripteur_fichier  *fichier;
  720: 
  721:     struct_objet                *s_objet_argument_1;
  722:     struct_objet                *s_objet_argument_2;
  723: 
  724:     unsigned char               *chaine;
  725: 
  726:     (*s_etat_processus).erreur_execution = d_ex;
  727: 
  728:     if ((*s_etat_processus).affichage_arguments == 'Y')
  729:     {
  730:         printf("\n  LOCK ");
  731:         
  732:         if ((*s_etat_processus).langue == 'F')
  733:         {
  734:             printf("(verrouillage d'un fichier)\n\n");
  735:         }
  736:         else
  737:         {
  738:             printf("(file lock)\n\n");
  739:         }
  740: 
  741:         printf("    2: %s\n", d_FCH);
  742:         printf("    1: %s (READ/WRITE/NONE)\n", d_CHN);
  743: 
  744:         return;
  745:     }
  746:     else if ((*s_etat_processus).test_instruction == 'Y')
  747:     {
  748:         (*s_etat_processus).nombre_arguments = -1;
  749:         return;
  750:     }
  751: 
  752:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  753:     {
  754:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
  755:         {
  756:             return;
  757:         }
  758:     }
  759: 
  760:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  761:             &s_objet_argument_1) == d_erreur)
  762:     {
  763:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  764:         return;
  765:     }
  766: 
  767:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  768:             &s_objet_argument_2) == d_erreur)
  769:     {
  770:         liberation(s_etat_processus, s_objet_argument_1);
  771: 
  772:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  773:         return;
  774:     }
  775: 
  776:     if (((*s_objet_argument_2).type == FCH) &&
  777:             ((*s_objet_argument_1).type == CHN))
  778:     {
  779:         lock.l_whence = SEEK_SET;
  780:         lock.l_start = 0;
  781:         lock.l_len = 0;
  782:         lock.l_pid = getpid();
  783: 
  784:         if ((chaine = conversion_majuscule(s_etat_processus, (unsigned char *)
  785:                 (*s_objet_argument_1).objet)) == NULL)
  786:         {
  787:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  788:             return;
  789:         }
  790: 
  791:         if (strcmp(chaine, "READ") == 0)
  792:         {
  793:             lock.l_type = F_WRLCK;
  794:         }
  795:         else if (strcmp(chaine, "WRITE") == 0)
  796:         {
  797:             lock.l_type = F_RDLCK;
  798:         }
  799:         else if (strcmp(chaine, "NONE") == 0)
  800:         {
  801:             lock.l_type = F_UNLCK;
  802:         }
  803:         else
  804:         {
  805:             free(chaine);
  806: 
  807:             liberation(s_etat_processus, s_objet_argument_1);
  808:             liberation(s_etat_processus, s_objet_argument_2);
  809: 
  810:             (*s_etat_processus).erreur_execution = d_ex_verrou_indefini;
  811:             return;
  812:         }
  813: 
  814:         free(chaine);
  815: 
  816:         if ((fichier = descripteur_fichier(s_etat_processus,
  817:                 (struct_fichier *) (*s_objet_argument_2).objet)) == NULL)
  818:         {
  819:             return;
  820:         }
  821: 
  822:         descripteur = (*fichier).descripteur_c;
  823: 
  824:         if (fcntl(fileno(descripteur), F_SETLK, &lock) == -1)
  825:         {
  826:             liberation(s_etat_processus, s_objet_argument_1);
  827:             liberation(s_etat_processus, s_objet_argument_2);
  828: 
  829:             (*s_etat_processus).erreur_execution = d_ex_fichier_verrouille;
  830:             return;
  831:         }
  832:     }
  833:     else
  834:     {
  835:         liberation(s_etat_processus, s_objet_argument_1);
  836:         liberation(s_etat_processus, s_objet_argument_2);
  837: 
  838:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  839:         return;
  840:     }
  841: 
  842:     return;
  843: }
  844: 
  845: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>