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

1.1     ! bertrand    1: /*
        !             2: ================================================================================
        !             3:   RPL/2 (R) version 4.0.9
        !             4:   Copyright (C) 1989-2010 Dr. BERTRAND Joël
        !             5: 
        !             6:   This file is part of RPL/2.
        !             7: 
        !             8:   RPL/2 is free software; you can redistribute it and/or modify it
        !             9:   under the terms of the CeCILL V2 License as published by the french
        !            10:   CEA, CNRS and INRIA.
        !            11:  
        !            12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
        !            13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
        !            14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
        !            15:   for more details.
        !            16:  
        !            17:   You should have received a copy of the CeCILL License
        !            18:   along with RPL/2. If not, write to info@cecill.info.
        !            19: ================================================================================
        !            20: */
        !            21: 
        !            22: 
        !            23: #include "rpl.conv.h"
        !            24: 
        !            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: 
        !           719:    struct_objet                *s_objet_argument_1;
        !           720:    struct_objet                *s_objet_argument_2;
        !           721: 
        !           722:    unsigned char               *chaine;
        !           723: 
        !           724:    (*s_etat_processus).erreur_execution = d_ex;
        !           725: 
        !           726:    if ((*s_etat_processus).affichage_arguments == 'Y')
        !           727:    {
        !           728:        printf("\n  LOCK ");
        !           729:        
        !           730:        if ((*s_etat_processus).langue == 'F')
        !           731:        {
        !           732:            printf("(verrouillage d'un fichier)\n\n");
        !           733:        }
        !           734:        else
        !           735:        {
        !           736:            printf("(file lock)\n\n");
        !           737:        }
        !           738: 
        !           739:        printf("    2: %s\n", d_FCH);
        !           740:        printf("    1: %s (READ/WRITE/NONE)\n", d_CHN);
        !           741: 
        !           742:        return;
        !           743:    }
        !           744:    else if ((*s_etat_processus).test_instruction == 'Y')
        !           745:    {
        !           746:        (*s_etat_processus).nombre_arguments = -1;
        !           747:        return;
        !           748:    }
        !           749: 
        !           750:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
        !           751:    {
        !           752:        if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
        !           753:        {
        !           754:            return;
        !           755:        }
        !           756:    }
        !           757: 
        !           758:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           759:            &s_objet_argument_1) == d_erreur)
        !           760:    {
        !           761:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
        !           762:        return;
        !           763:    }
        !           764: 
        !           765:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
        !           766:            &s_objet_argument_2) == d_erreur)
        !           767:    {
        !           768:        liberation(s_etat_processus, s_objet_argument_1);
        !           769: 
        !           770:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
        !           771:        return;
        !           772:    }
        !           773: 
        !           774:    if (((*s_objet_argument_2).type == FCH) &&
        !           775:            ((*s_objet_argument_1).type == CHN))
        !           776:    {
        !           777:        lock.l_whence = SEEK_SET;
        !           778:        lock.l_start = 0;
        !           779:        lock.l_len = 0;
        !           780:        lock.l_pid = getpid();
        !           781: 
        !           782:        if ((chaine = conversion_majuscule((unsigned char *)
        !           783:                (*s_objet_argument_1).objet)) == NULL)
        !           784:        {
        !           785:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
        !           786:            return;
        !           787:        }
        !           788: 
        !           789:        if (strcmp(chaine, "READ") == 0)
        !           790:        {
        !           791:            lock.l_type = F_WRLCK;
        !           792:        }
        !           793:        else if (strcmp(chaine, "WRITE") == 0)
        !           794:        {
        !           795:            lock.l_type = F_RDLCK;
        !           796:        }
        !           797:        else if (strcmp(chaine, "NONE") == 0)
        !           798:        {
        !           799:            lock.l_type = F_UNLCK;
        !           800:        }
        !           801:        else
        !           802:        {
        !           803:            free(chaine);
        !           804: 
        !           805:            liberation(s_etat_processus, s_objet_argument_1);
        !           806:            liberation(s_etat_processus, s_objet_argument_2);
        !           807: 
        !           808:            (*s_etat_processus).erreur_execution = d_ex_verrou_indefini;
        !           809:            return;
        !           810:        }
        !           811: 
        !           812:        free(chaine);
        !           813: 
        !           814:        if ((descripteur = descripteur_fichier(s_etat_processus,
        !           815:                (struct_fichier *) (*s_objet_argument_2).objet)) == NULL)
        !           816:        {
        !           817:            return;
        !           818:        }
        !           819: 
        !           820:        if (fcntl(fileno(descripteur), F_SETLK, &lock) == -1)
        !           821:        {
        !           822:            liberation(s_etat_processus, s_objet_argument_1);
        !           823:            liberation(s_etat_processus, s_objet_argument_2);
        !           824: 
        !           825:            (*s_etat_processus).erreur_execution = d_ex_fichier_verrouille;
        !           826:            return;
        !           827:        }
        !           828:    }
        !           829:    else
        !           830:    {
        !           831:        liberation(s_etat_processus, s_objet_argument_1);
        !           832:        liberation(s_etat_processus, s_objet_argument_2);
        !           833: 
        !           834:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
        !           835:        return;
        !           836:    }
        !           837: 
        !           838:    return;
        !           839: }
        !           840: 
        !           841: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>