Annotation of rpl/src/instructions_l4.c, revision 1.27

1.1       bertrand    1: /*
                      2: ================================================================================
1.27    ! bertrand    3:   RPL/2 (R) version 4.1.2
1.16      bertrand    4:   Copyright (C) 1989-2011 Dr. BERTRAND Joël
1.1       bertrand    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: 
1.12      bertrand   23: #include "rpl-conv.h"
1.1       bertrand   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:    unsigned long               i;
                     50:    unsigned long               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((*((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((*((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((*((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((*((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((*((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((*((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((*((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((*((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: 
1.5       bertrand  719:    struct_descripteur_fichier  *fichier;
                    720: 
1.1       bertrand  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((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: 
1.5       bertrand  816:        if ((fichier = descripteur_fichier(s_etat_processus,
1.1       bertrand  817:                (struct_fichier *) (*s_objet_argument_2).objet)) == NULL)
                    818:        {
                    819:            return;
                    820:        }
                    821: 
1.5       bertrand  822:        descripteur = (*fichier).descripteur_c;
                    823: 
1.1       bertrand  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>