Annotation of rpl/src/instructions_i2.c, revision 1.8

1.1       bertrand    1: /*
                      2: ================================================================================
1.8     ! bertrand    3:   RPL/2 (R) version 4.0.16
1.1       bertrand    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 'idn'
                     29: ================================================================================
                     30:   Entrées : pointeur sur une struct_processus
                     31: --------------------------------------------------------------------------------
                     32:   Sorties :
                     33: --------------------------------------------------------------------------------
                     34:   Effets de bord : néant
                     35: ================================================================================
                     36: */
                     37: 
                     38: void
                     39: instruction_idn(struct_processus *s_etat_processus)
                     40: {
                     41:    struct_objet                        *s_objet_argument;
                     42:    struct_objet                        *s_objet_resultat;
                     43: 
                     44:    logical1                            argument_nom;
                     45:    logical1                            variable_partagee;
                     46: 
                     47:    unsigned long                       i;
                     48:    unsigned long                       j;
                     49: 
                     50:    (*s_etat_processus).erreur_execution = d_ex;
                     51: 
                     52:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     53:    {
                     54:        printf("\n  IDN ");
                     55: 
                     56:        if ((*s_etat_processus).langue == 'F')
                     57:        {
                     58:            printf("(matrice identité)\n\n");
                     59:        }
                     60:        else
                     61:        {
                     62:            printf("(identity matrix)\n\n");
                     63:        }
                     64: 
                     65:        printf("    1: %s, %s, %s, %s\n",
                     66:                d_INT, d_MIN, d_MRL, d_MCX);
                     67:        printf("->  1: %s\n\n", d_MIN);
                     68: 
                     69:        printf("    1: %s\n", d_NOM);
                     70:        return;
                     71:    }
                     72:    else if ((*s_etat_processus).test_instruction == 'Y')
                     73:    {
                     74:        (*s_etat_processus).nombre_arguments = -1;
                     75:        return;
                     76:    }
                     77:    
                     78:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                     79:    {
                     80:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                     81:        {
                     82:            return;
                     83:        }
                     84:    }
                     85: 
                     86:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                     87:            &s_objet_argument) == d_erreur)
                     88:    {
                     89:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                     90:        return;
                     91:    }
                     92: 
                     93:    if ((*s_objet_argument).type == NOM)
                     94:    {
                     95:        argument_nom = d_vrai;
                     96: 
                     97:        if (recherche_variable(s_etat_processus, (*((struct_nom *)
                     98:                (*s_objet_argument).objet)).nom) == d_faux)
                     99:        {
                    100:            (*s_etat_processus).erreur_systeme = d_es;
                    101:            (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
                    102: 
                    103:            liberation(s_etat_processus, s_objet_argument);
                    104: 
                    105:            return;
                    106:        }
                    107: 
                    108:        liberation(s_etat_processus, s_objet_argument);
                    109: 
                    110:        if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
                    111:                .position_variable_courante].variable_verrouillee == d_vrai)
                    112:        {
                    113:            (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
                    114:            return;
                    115:        }
                    116: 
                    117:        s_objet_argument = (*s_etat_processus).s_liste_variables
                    118:                [(*s_etat_processus).position_variable_courante].objet;
                    119: 
                    120:        if (s_objet_argument == NULL)
                    121:        {
                    122:            if (pthread_mutex_lock(&((*(*s_etat_processus)
                    123:                    .s_liste_variables_partagees).mutex)) != 0)
                    124:            {
                    125:                (*s_etat_processus).erreur_systeme = d_es_processus;
                    126:                return;
                    127:            }
                    128: 
                    129:            if (recherche_variable_partagee(s_etat_processus,
                    130:                    (*s_etat_processus).s_liste_variables
                    131:                    [(*s_etat_processus).position_variable_courante].nom,
                    132:                    (*s_etat_processus).s_liste_variables
                    133:                    [(*s_etat_processus).position_variable_courante]
                    134:                    .variable_partagee, (*s_etat_processus).s_liste_variables
                    135:                    [(*s_etat_processus).position_variable_courante].origine)
                    136:                    == d_faux)
                    137:            {
                    138:                if (pthread_mutex_unlock(&((*(*s_etat_processus)
                    139:                        .s_liste_variables_partagees).mutex)) != 0)
                    140:                {
                    141:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                    142:                    return;
                    143:                }
                    144: 
                    145:                (*s_etat_processus).erreur_systeme = d_es;
                    146:                (*s_etat_processus).erreur_execution =
                    147:                        d_ex_variable_non_definie;
                    148: 
                    149:                return;
                    150:            }
                    151: 
                    152:            s_objet_argument = (*(*s_etat_processus)
                    153:                    .s_liste_variables_partagees).table[(*(*s_etat_processus)
                    154:                    .s_liste_variables_partagees).position_variable].objet;
                    155:            variable_partagee = d_vrai;
                    156:        }
                    157:        else
                    158:        {
                    159:            variable_partagee = d_faux;
                    160:        }
                    161:    }
                    162:    else
                    163:    {
                    164:        argument_nom = d_faux;
                    165:        variable_partagee = d_faux;
                    166:    }
                    167: 
                    168: /*
                    169: --------------------------------------------------------------------------------
                    170:   L'argument est la dimension de la matrice identité à créer ou une
                    171:   matrice carée dont les dimensions seront prises pour créer une matrice
                    172:   identité.
                    173: --------------------------------------------------------------------------------
                    174: */
                    175: 
                    176:    if (((*s_objet_argument).type == INT) ||
                    177:            ((*s_objet_argument).type == MIN) ||
                    178:            ((*s_objet_argument).type == MRL) ||
                    179:            ((*s_objet_argument).type == MCX))
                    180:    {
                    181:        if ((s_objet_resultat = allocation(s_etat_processus, MIN))
                    182:                == NULL)
                    183:        {
                    184:            if (variable_partagee == d_vrai)
                    185:            {
                    186:                if (pthread_mutex_unlock(&((*(*s_etat_processus)
                    187:                        .s_liste_variables_partagees).mutex)) != 0)
                    188:                {
                    189:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                    190:                    return;
                    191:                }
                    192:            }
                    193: 
                    194:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    195:            return;
                    196:        }
                    197: 
                    198:        if ((*s_objet_argument).type == INT)
                    199:        {
                    200:            (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
                    201:                    (*((integer8 *) (*s_objet_argument).objet));
                    202:            (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
                    203:                    (*((integer8 *) (*s_objet_argument).objet));
                    204:        }
                    205:        else
                    206:        {
                    207:            (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
                    208:                    (*((struct_matrice *) (*s_objet_argument).objet))
                    209:                    .nombre_lignes;
                    210:            (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
                    211:                    (*((struct_matrice *) (*s_objet_argument).objet))
                    212:                    .nombre_colonnes;
                    213: 
                    214:            if ((*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes
                    215:                    != (*((struct_matrice *) (*s_objet_resultat).objet))
                    216:                    .nombre_colonnes)
                    217:            {
                    218:                if (variable_partagee == d_vrai)
                    219:                {
                    220:                    if (pthread_mutex_unlock(&((*(*s_etat_processus)
                    221:                            .s_liste_variables_partagees).mutex)) != 0)
                    222:                    {
                    223:                        (*s_etat_processus).erreur_systeme = d_es_processus;
                    224:                        return;
                    225:                    }
                    226:                }
                    227: 
                    228:                if (argument_nom == d_faux)
                    229:                {
                    230:                    liberation(s_etat_processus, s_objet_argument);
                    231:                }
                    232: 
                    233:                free((struct_matrice *) (*s_objet_resultat).objet);
                    234:                free(s_objet_resultat);
                    235: 
                    236:                (*s_etat_processus).erreur_execution =
                    237:                        d_ex_dimensions_invalides;
                    238: 
                    239:                return;
                    240:            }
                    241:        }
                    242: 
                    243:        if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
                    244:                malloc((*((struct_matrice *) (*s_objet_resultat).objet))
                    245:                .nombre_lignes * sizeof(integer8 *))) == NULL)
                    246:        {
                    247:            if (variable_partagee == d_vrai)
                    248:            {
                    249:                if (pthread_mutex_unlock(&((*(*s_etat_processus)
                    250:                        .s_liste_variables_partagees).mutex)) != 0)
                    251:                {
                    252:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                    253:                    return;
                    254:                }
                    255:            }
                    256: 
                    257:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    258:            return;
                    259:        }
                    260: 
                    261:        for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
                    262:                .nombre_lignes; i++)
                    263:        {
                    264:            if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
                    265:                    .objet)).tableau)[i] = malloc((*((struct_matrice *)
                    266:                    (*s_objet_resultat).objet)).nombre_colonnes *
                    267:                    sizeof(integer8))) == NULL)
                    268:            {
                    269:                if (variable_partagee == d_vrai)
                    270:                {
                    271:                    if (pthread_mutex_unlock(&((*(*s_etat_processus)
                    272:                            .s_liste_variables_partagees).mutex)) != 0)
                    273:                    {
                    274:                        (*s_etat_processus).erreur_systeme = d_es_processus;
                    275:                        return;
                    276:                    }
                    277:                }
                    278: 
                    279:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    280:                return;
                    281:            }
                    282: 
                    283:            for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
                    284:                    .nombre_colonnes; j++)
                    285:            {
                    286:                ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
                    287:                        .objet)).tableau)[i][j] = (i == j) ? 1 : 0;
                    288:            }
                    289:        }
                    290:    }
                    291: 
                    292: /*
                    293: --------------------------------------------------------------------------------
                    294:   Réalisation de la fonction IDN impossible
                    295: --------------------------------------------------------------------------------
                    296: */
                    297: 
                    298:    else
                    299:    {
                    300:        if (variable_partagee == d_vrai)
                    301:        {
                    302:            if (pthread_mutex_unlock(&((*(*s_etat_processus)
                    303:                    .s_liste_variables_partagees).mutex)) != 0)
                    304:            {
                    305:                (*s_etat_processus).erreur_systeme = d_es_processus;
                    306:                return;
                    307:            }
                    308:        }
                    309: 
                    310:        liberation(s_etat_processus, s_objet_argument);
                    311: 
                    312:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    313:        return;
                    314:    }
                    315: 
                    316:    liberation(s_etat_processus, s_objet_argument);
                    317: 
                    318:    if (argument_nom == d_faux)
                    319:    {
                    320:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    321:                s_objet_resultat) == d_erreur)
                    322:        {
                    323:            return;
                    324:        }
                    325:    }
                    326:    else
                    327:    {
                    328:        if (variable_partagee == d_vrai)
                    329:        {
                    330:            (*s_etat_processus).s_liste_variables[(*s_etat_processus)
                    331:                    .position_variable_courante].objet = NULL;
                    332:            (*(*s_etat_processus).s_liste_variables_partagees).table
                    333:                    [(*(*s_etat_processus).s_liste_variables_partagees)
                    334:                    .position_variable].objet = s_objet_resultat;
                    335: 
                    336:            if (pthread_mutex_unlock(&((*(*s_etat_processus)
                    337:                    .s_liste_variables_partagees).mutex)) != 0)
                    338:            {
                    339:                (*s_etat_processus).erreur_systeme = d_es_processus;
                    340:                return;
                    341:            }
                    342:        }
                    343:        else
                    344:        {
                    345:            (*s_etat_processus).s_liste_variables[(*s_etat_processus)
                    346:                    .position_variable_courante].objet = s_objet_resultat;
                    347:        }
                    348:    }
                    349: 
                    350:    return;
                    351: }
                    352: 
                    353: 
                    354: /*
                    355: ================================================================================
                    356:   Fonction 'IFFT'
                    357: ================================================================================
                    358:   Entrées : structure processus
                    359: --------------------------------------------------------------------------------
                    360:   Sorties :
                    361: --------------------------------------------------------------------------------
                    362:   Effets de bord : néant
                    363: ================================================================================
                    364: */
                    365: 
                    366: void
                    367: instruction_ifft(struct_processus *s_etat_processus)
                    368: {
                    369:    integer4                    erreur;
                    370:    integer4                    inverse;
                    371:    integer4                    nombre_colonnes;
                    372:    integer4                    nombre_lignes;
                    373: 
                    374:    struct_complexe16           *matrice_f77;
                    375: 
                    376:    struct_objet                *s_objet_argument;
                    377:    struct_objet                *s_objet_longueur_fft;
                    378:    struct_objet                *s_objet_resultat;
                    379: 
                    380:    logical1                    presence_longueur_fft;
                    381: 
                    382:    unsigned long               i;
                    383:    unsigned long               j;
                    384:    unsigned long               k;
                    385:    unsigned long               longueur_fft;
                    386: 
                    387:    (*s_etat_processus).erreur_execution = d_ex;
                    388: 
                    389:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    390:    {
                    391:        printf("\n  IFFT ");
                    392: 
                    393:        if ((*s_etat_processus).langue == 'F')
                    394:        {
                    395:            printf("(transformée de Fourier inverse rapide)\n\n");
                    396:        }
                    397:        else
                    398:        {
                    399:            printf("(inverse of fast Fourier transform)\n\n");
                    400:        }
                    401: 
                    402:        printf("    2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
                    403:        printf("    1: %s\n", d_INT);
                    404:        printf("->  1: %s\n\n", d_VCX);
                    405: 
                    406:        printf("    1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
                    407:        printf("->  1: %s\n\n", d_VCX);
                    408: 
                    409:        printf("    2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
                    410:        printf("    1: %s\n", d_INT);
                    411:        printf("->  1: %s\n\n", d_MCX);
                    412: 
                    413:        printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
                    414:        printf("->  1: %s\n", d_MCX);
                    415: 
                    416:        return;
                    417:    }
                    418:    else if ((*s_etat_processus).test_instruction == 'Y')
                    419:    {
                    420:        (*s_etat_processus).nombre_arguments = -1;
                    421:        return;
                    422:    }
                    423:    
                    424:    /*
                    425:     * Il est possible d'imposer une longueur de FFT au premier niveau
                    426:     * de la pile.
                    427:     */
                    428: 
                    429:    if ((*s_etat_processus).l_base_pile == NULL)
                    430:    {
                    431:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    432:        return;
                    433:    }
                    434: 
                    435:    if ((*(*(*s_etat_processus).l_base_pile).donnee).type == INT)
                    436:    {
                    437:        presence_longueur_fft = d_vrai;
                    438: 
                    439:        if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    440:        {
                    441:            if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
                    442:            {
                    443:                return;
                    444:            }
                    445:        }
                    446: 
                    447:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    448:                &s_objet_longueur_fft) == d_erreur)
                    449:        {
                    450:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    451:            return;
                    452:        }
                    453: 
                    454:        longueur_fft = (*((integer8 *) (*s_objet_longueur_fft).objet));
                    455: 
                    456:        liberation(s_etat_processus, s_objet_longueur_fft);
                    457:    }
                    458:    else
                    459:    {
                    460:        presence_longueur_fft = d_faux;
                    461:        longueur_fft = 0;
                    462: 
                    463:        if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    464:        {
                    465:            if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    466:            {
                    467:                return;
                    468:            }
                    469:        }
                    470:    }
                    471: 
                    472:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    473:            &s_objet_argument) == d_erreur)
                    474:    {
                    475:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    476:        return;
                    477:    }
                    478: 
                    479: /*
                    480: --------------------------------------------------------------------------------
                    481:   Vecteur
                    482: --------------------------------------------------------------------------------
                    483: */
                    484: 
                    485:    if (((*s_objet_argument).type == VIN) ||
                    486:            ((*s_objet_argument).type == VRL) ||
                    487:            ((*s_objet_argument).type == VCX))
                    488:    {
                    489:        if (presence_longueur_fft == d_faux)
                    490:        {
                    491:            longueur_fft = pow(2, (integer4) ceil(log((real8)
                    492:                    (*((struct_vecteur *)
                    493:                    (*s_objet_argument).objet)).taille) / log((real8) 2)));
                    494: 
                    495:            if ((longueur_fft / ((real8) (*((struct_vecteur *)
                    496:                    (*s_objet_argument).objet)).taille)) == 2)
                    497:            {
                    498:                longueur_fft /= 2;
                    499:            }
                    500:        }
                    501: 
                    502:        if ((matrice_f77 = malloc(longueur_fft *
                    503:                sizeof(struct_complexe16))) == NULL)
                    504:        {
                    505:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    506:            return;
                    507:        }
                    508: 
                    509:        if ((*s_objet_argument).type == VIN)
                    510:        {
                    511:            for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
                    512:                    .taille; i++)
                    513:            {
                    514:                matrice_f77[i].partie_reelle = (real8) ((integer8 *)
                    515:                        (*((struct_vecteur *) (*s_objet_argument).objet))
                    516:                        .tableau)[i];
                    517:                matrice_f77[i].partie_imaginaire = (real8) 0;
                    518:            }
                    519:        }
                    520:        else if ((*s_objet_argument).type == VRL)
                    521:        {
                    522:            for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
                    523:                    .taille; i++)
                    524:            {
                    525:                matrice_f77[i].partie_reelle = ((real8 *)
                    526:                        (*((struct_vecteur *) (*s_objet_argument).objet))
                    527:                        .tableau)[i];
                    528:                matrice_f77[i].partie_imaginaire = (real8) 0;
                    529:            }
                    530:        }
                    531:        else
                    532:        {
                    533:            for(i = 0; i < (*((struct_vecteur *) (*s_objet_argument).objet))
                    534:                    .taille; i++)
                    535:            {
                    536:                matrice_f77[i].partie_reelle = ((struct_complexe16 *)
                    537:                        (*((struct_vecteur *) (*s_objet_argument).objet))
                    538:                        .tableau)[i].partie_reelle;
                    539:                matrice_f77[i].partie_imaginaire = ((struct_complexe16 *)
                    540:                        (*((struct_vecteur *) (*s_objet_argument).objet))
                    541:                        .tableau)[i].partie_imaginaire;
                    542:            }
                    543:        }
                    544: 
                    545:        for(; i < longueur_fft; i++)
                    546:        {
                    547:                matrice_f77[i].partie_reelle = (real8) 0;
                    548:                matrice_f77[i].partie_imaginaire = (real8) 0;
                    549:        }
                    550: 
                    551:        nombre_lignes = 1;
                    552:        nombre_colonnes = longueur_fft;
                    553:        inverse = -1;
                    554: 
                    555:        dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
                    556: 
                    557:        if (erreur != 0)
                    558:        {
                    559:            liberation(s_etat_processus, s_objet_argument);
                    560:            free(matrice_f77);
                    561: 
                    562:            (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
                    563:            return;
                    564:        }
                    565: 
                    566:        if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
                    567:        {
                    568:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    569:            return;
                    570:        }
                    571: 
                    572:        (*((struct_vecteur *) (*s_objet_resultat).objet)).taille = longueur_fft;
                    573:        (*((struct_vecteur *) (*s_objet_resultat).objet)).tableau = matrice_f77;
                    574:    }
                    575: 
                    576: /*
                    577: --------------------------------------------------------------------------------
                    578:   Matrice
                    579: --------------------------------------------------------------------------------
                    580: */
                    581: 
                    582:    else if (((*s_objet_argument).type == MIN) ||
                    583:            ((*s_objet_argument).type == MRL) ||
                    584:            ((*s_objet_argument).type == MCX))
                    585:    {
                    586:        if (presence_longueur_fft == d_faux)
                    587:        {
                    588:            longueur_fft = pow(2, (integer4) ceil(log((real8)
                    589:                    (*((struct_matrice *)
                    590:                    (*s_objet_argument).objet)).nombre_colonnes) /
                    591:                    log((real8) 2)));
                    592: 
                    593:            if ((longueur_fft / ((real8) (*((struct_matrice *)
                    594:                    (*s_objet_argument).objet)).nombre_colonnes)) == 2)
                    595:            {
                    596:                longueur_fft /= 2;
                    597:            }
                    598:        }
                    599: 
                    600:        if ((matrice_f77 = malloc(longueur_fft *
                    601:                (*((struct_matrice *) (*s_objet_argument).objet))
                    602:                .nombre_lignes * sizeof(struct_complexe16))) == NULL)
                    603:        {
                    604:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    605:            return;
                    606:        }
                    607: 
                    608:        if ((*s_objet_argument).type == MIN)
                    609:        {
                    610:            for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
                    611:                    .objet)).nombre_colonnes; i++)
                    612:            {
                    613:                for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
                    614:                        .objet)).nombre_lignes; j++)
                    615:                {
                    616:                    matrice_f77[k].partie_reelle = (real8) ((integer8 **)
                    617:                            (*((struct_matrice *) (*s_objet_argument).objet))
                    618:                            .tableau)[j][i];
                    619:                    matrice_f77[k++].partie_imaginaire = (real8) 0;
                    620:                }
                    621:            }
                    622: 
                    623:            for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
                    624:                    .objet)).nombre_lignes; k++)
                    625:            {
                    626:                matrice_f77[k].partie_reelle = (real8) 0;
                    627:                matrice_f77[k].partie_imaginaire = (real8) 0;
                    628:            }
                    629:        }
                    630:        else if ((*s_objet_argument).type == MRL)
                    631:        {
                    632:            for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
                    633:                    .objet)).nombre_colonnes; i++)
                    634:            {
                    635:                for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
                    636:                        .objet)).nombre_lignes; j++)
                    637:                {
                    638:                    matrice_f77[k].partie_reelle = ((real8 **)
                    639:                            (*((struct_matrice *) (*s_objet_argument).objet))
                    640:                            .tableau)[j][i];
                    641:                    matrice_f77[k++].partie_imaginaire = (real8) 0;
                    642:                }
                    643:            }
                    644: 
                    645:            for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
                    646:                    .objet)).nombre_lignes; k++)
                    647:            {
                    648:                matrice_f77[k].partie_reelle = (real8) 0;
                    649:                matrice_f77[k].partie_imaginaire = (real8) 0;
                    650:            }
                    651:        }
                    652:        else
                    653:        {
                    654:            for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_argument)
                    655:                    .objet)).nombre_colonnes; i++)
                    656:            {
                    657:                for(j = 0; j < (*((struct_matrice *) (*s_objet_argument)
                    658:                        .objet)).nombre_lignes; j++)
                    659:                {
                    660:                    matrice_f77[k].partie_reelle = ((struct_complexe16 **)
                    661:                            (*((struct_matrice *) (*s_objet_argument).objet))
                    662:                            .tableau)[j][i].partie_reelle;
                    663:                    matrice_f77[k++].partie_imaginaire =
                    664:                            ((struct_complexe16 **) (*((struct_matrice *)
                    665:                            (*s_objet_argument).objet)).tableau)[j][i]
                    666:                            .partie_imaginaire;
                    667:                }
                    668:            }
                    669: 
                    670:            for(; k < longueur_fft * (*((struct_matrice *) (*s_objet_argument)
                    671:                    .objet)).nombre_lignes; k++)
                    672:            {
                    673:                matrice_f77[k].partie_reelle = (real8) 0;
                    674:                matrice_f77[k].partie_imaginaire = (real8) 0;
                    675:            }
                    676:        }
                    677: 
                    678:        nombre_lignes = (*((struct_matrice *) (*s_objet_argument).objet))
                    679:                .nombre_lignes;
                    680:        nombre_colonnes = longueur_fft;
                    681:        inverse = -1;
                    682: 
                    683:        dft(matrice_f77, &nombre_lignes, &nombre_colonnes, &inverse, &erreur);
                    684: 
                    685:        if (erreur != 0)
                    686:        {
                    687:            liberation(s_etat_processus, s_objet_argument);
                    688:            free(matrice_f77);
                    689: 
                    690:            (*s_etat_processus).erreur_execution = d_ex_longueur_fft;
                    691:            return;
                    692:        }
                    693: 
                    694:        if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
                    695:        {
                    696:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    697:            return;
                    698:        }
                    699: 
                    700:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
                    701:                (*((struct_matrice *) (*s_objet_argument).objet))
                    702:                .nombre_lignes;
                    703:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
                    704:                longueur_fft;
                    705: 
                    706:        if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
                    707:                malloc((*((struct_matrice *) (*s_objet_resultat).objet))
                    708:                .nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
                    709:        {
                    710:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    711:            return;
                    712:        }
                    713: 
                    714:        for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
                    715:                .nombre_lignes; i++)
                    716:        {
                    717:            if ((((struct_complexe16 **) (*((struct_matrice *)
                    718:                    (*s_objet_resultat).objet)).tableau)[i] =
                    719:                    malloc((*((struct_matrice *)
                    720:                    (*s_objet_resultat).objet)).nombre_colonnes *
                    721:                    sizeof(struct_complexe16))) == NULL)
                    722:            {
                    723:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    724:                return;
                    725:            }
                    726:        }
                    727: 
                    728:        for(k = 0, i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
                    729:                .nombre_colonnes; i++)
                    730:        {
                    731:            for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
                    732:                    .nombre_lignes; j++)
                    733:            {
                    734:                ((struct_complexe16 **) (*((struct_matrice *)
                    735:                        (*s_objet_resultat).objet)).tableau)[j][i]
                    736:                        .partie_reelle = matrice_f77[k].partie_reelle;
                    737:                ((struct_complexe16 **) (*((struct_matrice *)
                    738:                        (*s_objet_resultat).objet)).tableau)[j][i]
                    739:                        .partie_imaginaire = matrice_f77[k++].partie_imaginaire;
                    740:            }
                    741:        }
                    742: 
                    743:        free(matrice_f77);
                    744:    }
                    745: 
                    746: /*
                    747: --------------------------------------------------------------------------------
                    748:   Calcul de FFT impossible
                    749: --------------------------------------------------------------------------------
                    750: */
                    751: 
                    752:    else
                    753:    {
                    754:        liberation(s_etat_processus, s_objet_argument);
                    755: 
                    756:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    757:        return;
                    758:    }
                    759: 
                    760:    liberation(s_etat_processus, s_objet_argument);
                    761: 
                    762:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    763:            s_objet_resultat) == d_erreur)
                    764:    {
                    765:        return;
                    766:    }
                    767: 
                    768:    return;
                    769: }
                    770: 
                    771: 
                    772: /*
                    773: ================================================================================
                    774:   Fonction 'input'
                    775: ================================================================================
                    776:   Entrées :
                    777: --------------------------------------------------------------------------------
                    778:   Sorties :
                    779: --------------------------------------------------------------------------------
                    780:   Effets de bord : néant
                    781: ================================================================================
                    782: */
                    783: 
                    784: void
                    785: instruction_input(struct_processus *s_etat_processus)
                    786: {
                    787:    struct_objet                *s_objet_resultat;
                    788: 
                    789:    unsigned char               *tampon;
                    790: 
                    791:    (*s_etat_processus).erreur_execution = d_ex;
                    792: 
                    793:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    794:    {
                    795:        printf("\n  INPUT ");
                    796: 
                    797:        if ((*s_etat_processus).langue == 'F')
                    798:        {
                    799:            printf("(attente d'une entrée)\n\n");
                    800:        }
                    801:        else
                    802:        {
                    803:            printf("(input)\n\n");
                    804:        }
                    805: 
                    806:        printf("->  1: %s\n", d_CHN);
                    807: 
                    808:        return;
                    809:    }
                    810:    else if ((*s_etat_processus).test_instruction == 'Y')
                    811:    {
                    812:        (*s_etat_processus).nombre_arguments = -1;
                    813:        return;
                    814:    }
                    815:    
                    816:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    817:    {
                    818:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                    819:        {
                    820:            return;
                    821:        }
                    822:    }
                    823: 
                    824:    if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
                    825:    {
                    826:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    827:        return;
                    828:    }
                    829: 
                    830:    flockfile(stdin);
                    831:    (*s_objet_resultat).objet = (void *) readline("");
                    832:    funlockfile(stdin);
                    833: 
                    834:    if ((*s_objet_resultat).objet == NULL)
                    835:    {
                    836:        if (((*s_objet_resultat).objet = malloc(sizeof(unsigned char)))
                    837:                == NULL)
                    838:        {
                    839:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    840:            return;
                    841:        }
                    842: 
                    843:        (*((unsigned char *) (*s_objet_resultat).objet)) =
                    844:                d_code_fin_chaine;
                    845:    }
                    846: 
                    847:    if ((tampon = transliteration(s_etat_processus,
                    848:            (unsigned char *) (*s_objet_resultat).objet,
                    849:            (*s_etat_processus).localisation, d_locale)) == NULL)
                    850:    {
                    851:        return;
                    852:    }
                    853: 
                    854:    free((unsigned char *) (*s_objet_resultat).objet);
                    855:    (*s_objet_resultat).objet = tampon;
                    856: 
                    857:    add_history((unsigned char *) (*s_objet_resultat).objet);
                    858:    stifle_history(ds_longueur_historique);
                    859: 
                    860:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    861:            s_objet_resultat) == d_erreur)
                    862:    {
                    863:        return;
                    864:    }
                    865: 
                    866:    return;
                    867: }
                    868: 
                    869: 
                    870: /*
                    871: ================================================================================
                    872:   Fonction 'indep'
                    873: ================================================================================
                    874:   Entrées : pointeur sur une structure struct_processus
                    875: --------------------------------------------------------------------------------
                    876:   Sorties :
                    877: --------------------------------------------------------------------------------
                    878:   Effets de bord : néant
                    879: ================================================================================
                    880: */
                    881: 
                    882: void
                    883: instruction_indep(struct_processus *s_etat_processus)
                    884: {
                    885:    struct_liste_chainee            *l_element_courant;
                    886: 
                    887:    struct_objet                    *s_objet;
                    888: 
                    889:    (*s_etat_processus).erreur_execution = d_ex;
                    890: 
                    891:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    892:    {
                    893:        printf("\n  INDEP ");
                    894: 
                    895:        if ((*s_etat_processus).langue == 'F')
                    896:        {
                    897:            printf("(indication de la variable indépendante)\n\n");
                    898:        }
                    899:        else
                    900:        {
                    901:            printf("(set independant variable)\n\n");
                    902:        }
                    903: 
                    904:        printf("    1: %s, %s\n", d_NOM, d_LST);
                    905: 
                    906:        return;
                    907:    }
                    908:    else if ((*s_etat_processus).test_instruction == 'Y')
                    909:    {
                    910:        (*s_etat_processus).nombre_arguments = -1;
                    911:        return;
                    912:    }
                    913:    
                    914:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    915:    {
                    916:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    917:        {
                    918:            return;
                    919:        }
                    920:    }
                    921: 
                    922:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    923:            &s_objet) == d_erreur)
                    924:    {
                    925:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    926:        return;
                    927:    }
                    928: 
                    929:    if ((*s_objet).type == NOM)
                    930:    {
                    931:        liberation(s_etat_processus, (*s_etat_processus).indep);
                    932:        (*s_etat_processus).indep = s_objet;
                    933:    }
                    934:    else if ((*s_objet).type == LST)
                    935:    {
                    936:        l_element_courant = (struct_liste_chainee *) (*s_objet).objet;
                    937: 
                    938:        if ((*(*l_element_courant).donnee).type != NOM)
                    939:        {
                    940:            liberation(s_etat_processus, s_objet);
                    941: 
                    942:            (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    943:            return;
                    944:        }
                    945: 
                    946:        (*((struct_nom *) (*(*l_element_courant).donnee).objet)).symbole =
                    947:                d_vrai;
                    948: 
                    949:        l_element_courant = (*l_element_courant).suivant;
                    950: 
                    951:        if (!(((*(*l_element_courant).donnee).type == INT) ||
                    952:                ((*(*l_element_courant).donnee).type == REL) ||
                    953:                ((*(*l_element_courant).donnee).type == NOM) ||
                    954:                ((*(*l_element_courant).donnee).type == ALG) ||
                    955:                ((*(*l_element_courant).donnee).type == RPN)))
                    956:        {
                    957:            liberation(s_etat_processus, s_objet);
                    958: 
                    959:            (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    960:            return;
                    961:        }
                    962: 
                    963:        l_element_courant = (*l_element_courant).suivant;
                    964: 
                    965:        if (!(((*(*l_element_courant).donnee).type == INT) ||
                    966:                ((*(*l_element_courant).donnee).type == REL) ||
                    967:                ((*(*l_element_courant).donnee).type == NOM) ||
                    968:                ((*(*l_element_courant).donnee).type == ALG) ||
                    969:                ((*(*l_element_courant).donnee).type == RPN)))
                    970:        {
                    971:            liberation(s_etat_processus, s_objet);
                    972: 
                    973:            (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    974:            return;
                    975:        }
                    976: 
                    977:        l_element_courant = (*l_element_courant).suivant;
                    978: 
                    979:        if (l_element_courant != NULL)
                    980:        {
                    981:            liberation(s_etat_processus, s_objet);
                    982: 
                    983:            (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    984:            return;
                    985:        }
                    986: 
                    987:        liberation(s_etat_processus, (*s_etat_processus).indep);
                    988:        (*s_etat_processus).indep = s_objet;
                    989:    }
                    990:    else
                    991:    {
                    992:        liberation(s_etat_processus, s_objet);
                    993: 
                    994:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    995:        return;
                    996:    }
                    997: 
                    998:    return;
                    999: }
                   1000: 
                   1001: 
                   1002: /*
                   1003: ================================================================================
                   1004:   Fonction 'int'
                   1005: ================================================================================
                   1006:   Entrées : pointeur sur une struct_processus
                   1007: --------------------------------------------------------------------------------
                   1008:   Sorties :
                   1009: --------------------------------------------------------------------------------
                   1010:   Effets de bord : néant
                   1011: ================================================================================
                   1012: */
                   1013: 
                   1014: void
                   1015: instruction_int(struct_processus *s_etat_processus)
                   1016: {
                   1017:    logical1                    last_valide;
                   1018: 
                   1019:    real8                       borne_maximale;
                   1020:    real8                       borne_minimale;
                   1021:    real8                       precision;
                   1022: 
                   1023:    struct_liste_chainee        *l_element_courant;
                   1024: 
                   1025:    struct_objet                *s_objet_argument_1;
                   1026:    struct_objet                *s_objet_argument_2;
                   1027:    struct_objet                *s_objet_argument_3;
                   1028:    struct_objet                *s_objet_evalue;
                   1029: 
                   1030:    unsigned char               *nom_variable;
                   1031: 
                   1032:    (*s_etat_processus).erreur_execution = d_ex;
                   1033: 
                   1034:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1035:    {
                   1036:        printf("\n  INT ");
                   1037: 
                   1038:        if ((*s_etat_processus).langue == 'F')
                   1039:        {
                   1040:            printf("(intégration numérique)\n\n");
                   1041:        }
                   1042:        else
                   1043:        {
                   1044:            printf("(numerical integration)\n\n");
                   1045:        }
                   1046: 
                   1047:        printf("    3: %s, %s, %s\n", d_NOM, d_ALG, d_RPN);
                   1048:        printf("    2: %s\n", d_LST);
                   1049:        printf("    1: %s, %s\n", d_INT, d_REL);
                   1050:        printf("->  2: %s, %s\n", d_INT, d_REL);
                   1051:        printf("    1: %s, %s\n", d_INT, d_REL);
                   1052: 
                   1053:        return;
                   1054:    }
                   1055:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1056:    {
                   1057:        (*s_etat_processus).nombre_arguments = 3;
                   1058:        return;
                   1059:    }
                   1060:    
                   1061:    if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
                   1062:    {
                   1063:        if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
                   1064:        {
                   1065:            return;
                   1066:        }
                   1067:    }
                   1068: 
                   1069:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1070:            &s_objet_argument_1) == d_erreur)
                   1071:    {
                   1072:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1073:        return;
                   1074:    }
                   1075: 
                   1076:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1077:            &s_objet_argument_2) == d_erreur)
                   1078:    {
                   1079:        liberation(s_etat_processus, s_objet_argument_1);
                   1080: 
                   1081:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1082:        return;
                   1083:    }
                   1084: 
                   1085:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1086:            &s_objet_argument_3) == d_erreur)
                   1087:    {
                   1088:        liberation(s_etat_processus, s_objet_argument_1);
                   1089:        liberation(s_etat_processus, s_objet_argument_2);
                   1090: 
                   1091:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1092:        return;
                   1093:    }
                   1094: 
                   1095:    if ((*s_objet_argument_1).type == INT)
                   1096:    {
                   1097:        precision = (*((integer8 *) (*s_objet_argument_1).objet));
                   1098:    }
                   1099:    else if ((*s_objet_argument_1).type == REL)
                   1100:    {
                   1101:        precision = (*((real8 *) (*s_objet_argument_1).objet));
                   1102:    }
                   1103:    else
                   1104:    {
                   1105:        liberation(s_etat_processus, s_objet_argument_1);
                   1106:        liberation(s_etat_processus, s_objet_argument_2);
                   1107:        liberation(s_etat_processus, s_objet_argument_3);
                   1108: 
                   1109:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1110:        return;
                   1111:    }
                   1112: 
                   1113:    if ((*s_objet_argument_2).type == LST)
                   1114:    {
                   1115:        l_element_courant = (*s_objet_argument_2).objet;
                   1116: 
                   1117:        if ((*(*l_element_courant).donnee).type != NOM)
                   1118:        {
                   1119:            liberation(s_etat_processus, s_objet_argument_1);
                   1120:            liberation(s_etat_processus, s_objet_argument_2);
                   1121:            liberation(s_etat_processus, s_objet_argument_3);
                   1122: 
                   1123:            (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1124:            return;
                   1125:        }
                   1126: 
                   1127:        if ((nom_variable = malloc((strlen((*((struct_nom *)
                   1128:                (*(*l_element_courant).donnee).objet)).nom)
                   1129:                + 1) * sizeof(unsigned char))) == NULL)
                   1130:        {
                   1131:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1132:            return;
                   1133:        }
                   1134: 
                   1135:        strcpy(nom_variable, (*((struct_nom *) (*(*l_element_courant)
                   1136:                .donnee).objet)).nom);
                   1137: 
                   1138:        l_element_courant = (*l_element_courant).suivant;
                   1139: 
                   1140:        if ((*(*l_element_courant).donnee).type == INT)
                   1141:        {
                   1142:            borne_minimale = (real8) (*((integer8 *)
                   1143:                    (*(*l_element_courant).donnee).objet));
                   1144:        }
                   1145:        else if ((*(*l_element_courant).donnee).type == REL)
                   1146:        {
                   1147:            borne_minimale = (*((real8 *) (*(*l_element_courant)
                   1148:                    .donnee).objet));
                   1149:        }
                   1150:        else
                   1151:        {
                   1152:            if (evaluation(s_etat_processus, (*l_element_courant).donnee,
                   1153:                    'N') == d_erreur)
                   1154:            {
                   1155:                free(nom_variable);
                   1156:                liberation(s_etat_processus, s_objet_argument_1);
                   1157:                liberation(s_etat_processus, s_objet_argument_2);
                   1158:                liberation(s_etat_processus, s_objet_argument_3);
                   1159: 
                   1160:                return;
                   1161:            }
                   1162: 
                   1163:            if (depilement(s_etat_processus, &((*s_etat_processus)
                   1164:                    .l_base_pile), &s_objet_evalue) == d_erreur)
                   1165:            {
                   1166:                free(nom_variable);
                   1167:                liberation(s_etat_processus, s_objet_argument_1);
                   1168:                liberation(s_etat_processus, s_objet_argument_2);
                   1169:                liberation(s_etat_processus, s_objet_argument_3);
                   1170: 
                   1171:                (*s_etat_processus).erreur_execution =
                   1172:                        d_ex_manque_argument;
                   1173:                return;
                   1174:            }
                   1175: 
                   1176:            if ((*s_objet_evalue).type == INT)
                   1177:            {
                   1178:                borne_minimale = (real8) (*((integer8 *)
                   1179:                        (*s_objet_evalue).objet));
                   1180:            }
                   1181:            else if ((*s_objet_evalue).type == REL)
                   1182:            {
                   1183:                borne_minimale = (*((real8 *) (*s_objet_evalue).objet));
                   1184:            }
                   1185:            else
                   1186:            {
                   1187:                free(nom_variable);
                   1188:                
                   1189:                liberation(s_etat_processus, s_objet_evalue);
                   1190:                liberation(s_etat_processus, s_objet_argument_1);
                   1191:                liberation(s_etat_processus, s_objet_argument_2);
                   1192:                liberation(s_etat_processus, s_objet_argument_3);
                   1193: 
                   1194:                (*s_etat_processus).erreur_execution =
                   1195:                        d_ex_erreur_type_argument;
                   1196:                return;
                   1197:            }
                   1198: 
                   1199:            liberation(s_etat_processus, s_objet_evalue);
                   1200:        }
                   1201: 
                   1202:        l_element_courant = (*l_element_courant).suivant;
                   1203: 
                   1204:        if ((*(*l_element_courant).donnee).type == INT)
                   1205:        {
                   1206:            borne_maximale = (real8) (*((integer8 *)
                   1207:                    (*(*l_element_courant).donnee).objet));
                   1208:        }
                   1209:        else if ((*(*l_element_courant).donnee).type == REL)
                   1210:        {
                   1211:            borne_maximale = (*((real8 *) (*(*l_element_courant)
                   1212:                    .donnee).objet));
                   1213:        }
                   1214:        else
                   1215:        {
                   1216:            if (evaluation(s_etat_processus, (*l_element_courant).donnee,
                   1217:                    'N') == d_erreur)
                   1218:            {
                   1219:                free(nom_variable);
                   1220:                liberation(s_etat_processus, s_objet_argument_1);
                   1221:                liberation(s_etat_processus, s_objet_argument_2);
                   1222:                liberation(s_etat_processus, s_objet_argument_3);
                   1223: 
                   1224:                return;
                   1225:            }
                   1226: 
                   1227:            if (depilement(s_etat_processus, &((*s_etat_processus)
                   1228:                    .l_base_pile), &s_objet_evalue) == d_erreur)
                   1229:            {
                   1230:                free(nom_variable);
                   1231:                liberation(s_etat_processus, s_objet_argument_1);
                   1232:                liberation(s_etat_processus, s_objet_argument_2);
                   1233:                liberation(s_etat_processus, s_objet_argument_3);
                   1234: 
                   1235:                (*s_etat_processus).erreur_execution =
                   1236:                        d_ex_manque_argument;
                   1237:                return;
                   1238:            }
                   1239: 
                   1240:            if ((*s_objet_evalue).type == INT)
                   1241:            {
                   1242:                borne_maximale = (real8) (*((integer8 *)
                   1243:                        (*s_objet_evalue).objet));
                   1244:            }
                   1245:            else if ((*s_objet_evalue).type == REL)
                   1246:            {
                   1247:                borne_maximale = (*((real8 *) (*s_objet_evalue).objet));
                   1248:            }
                   1249:            else
                   1250:            {
                   1251:                free(nom_variable);
                   1252: 
                   1253:                liberation(s_etat_processus, s_objet_evalue);
                   1254:                liberation(s_etat_processus, s_objet_argument_1);
                   1255:                liberation(s_etat_processus, s_objet_argument_2);
                   1256:                liberation(s_etat_processus, s_objet_argument_3);
                   1257: 
                   1258:                (*s_etat_processus).erreur_execution =
                   1259:                        d_ex_erreur_type_argument;
                   1260:                return;
                   1261:            }
                   1262: 
                   1263:            liberation(s_etat_processus, s_objet_evalue);
                   1264:        }
                   1265: 
                   1266:        /*
                   1267:         * Le résultat est retourné sur la pile par la routine
                   1268:         */
                   1269: 
                   1270:        if (last_valide == d_vrai)
                   1271:        {
                   1272:            cf(s_etat_processus, 31);
                   1273:        }
                   1274: 
                   1275:        integrale_romberg(s_etat_processus, s_objet_argument_3, nom_variable,
                   1276:                borne_minimale, borne_maximale, precision);
                   1277: 
                   1278:        if (last_valide == d_vrai)
                   1279:        {
                   1280:            sf(s_etat_processus, 31);
                   1281:        }
                   1282: 
                   1283:        free(nom_variable);
                   1284:    }
                   1285:    else
                   1286:    {
                   1287:        liberation(s_etat_processus, s_objet_argument_1);
                   1288:        liberation(s_etat_processus, s_objet_argument_2);
                   1289:        liberation(s_etat_processus, s_objet_argument_3);
                   1290: 
                   1291:        (*s_etat_processus).erreur_execution =
                   1292:                d_ex_erreur_type_argument;
                   1293:        return;
                   1294:    }
                   1295: 
                   1296:    liberation(s_etat_processus, s_objet_argument_1);
                   1297:    liberation(s_etat_processus, s_objet_argument_2);
                   1298:    liberation(s_etat_processus, s_objet_argument_3);
                   1299: 
                   1300:    return;
                   1301: }
                   1302: 
                   1303: 
                   1304: /*
                   1305: ================================================================================
                   1306:   Fonction 'incr'
                   1307: ================================================================================
                   1308:   Entrées :
                   1309: --------------------------------------------------------------------------------
                   1310:   Sorties :
                   1311: --------------------------------------------------------------------------------
                   1312:   Effets de bord : néant
                   1313: ================================================================================
                   1314: */
                   1315: 
                   1316: void
                   1317: instruction_incr(struct_processus *s_etat_processus)
                   1318: {
                   1319:    logical1                    variable_partagee;
                   1320: 
                   1321:    struct_objet                *s_copie_argument;
                   1322:    struct_objet                *s_objet_argument;
                   1323: 
                   1324:    (*s_etat_processus).erreur_execution = d_ex;
                   1325: 
                   1326:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1327:    {
                   1328:        printf("\n  INCR ");
                   1329: 
                   1330:        if ((*s_etat_processus).langue == 'F')
                   1331:        {
                   1332:            printf("(incrémentation)\n\n");
                   1333:        }
                   1334:        else
                   1335:        {
                   1336:            printf("(incrementation)\n\n");
                   1337:        }
                   1338: 
                   1339:        printf("    1: %s\n", d_INT);
                   1340:        printf("->  1: %s\n\n", d_INT);
                   1341: 
                   1342:        printf("    1: %s\n", d_NOM);
                   1343: 
                   1344:        return;
                   1345:    }
                   1346:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1347:    {
                   1348:        (*s_etat_processus).nombre_arguments = -1;
                   1349:        return;
                   1350:    }
                   1351:    
                   1352:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   1353:    {
                   1354:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   1355:        {
                   1356:            return;
                   1357:        }
                   1358:    }
                   1359: 
                   1360:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1361:            &s_objet_argument) == d_erreur)
                   1362:    {
                   1363:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1364:        return;
                   1365:    }
                   1366: 
                   1367:    if ((*s_objet_argument).type == INT)
                   1368:    {
                   1369:        if ((s_copie_argument = copie_objet(s_etat_processus,
                   1370:                s_objet_argument, 'O')) == NULL)
                   1371:        {
                   1372:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1373:            return;
                   1374:        }
                   1375: 
                   1376:        liberation(s_etat_processus, s_objet_argument);
                   1377:        s_objet_argument = s_copie_argument;
                   1378: 
                   1379:        (*((integer8 *) (*s_objet_argument).objet))++;
                   1380: 
                   1381:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1382:                s_objet_argument) == d_erreur)
                   1383:        {
                   1384:            return;
                   1385:        }
                   1386:    }
                   1387:    else if ((*s_objet_argument).type == NOM)
                   1388:    {
                   1389:        if (recherche_variable(s_etat_processus, (*((struct_nom *)
                   1390:                (*s_objet_argument).objet)).nom) == d_faux)
                   1391:        {
                   1392:            (*s_etat_processus).erreur_systeme = d_es;
                   1393:            (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
                   1394: 
                   1395:            return;
                   1396:        }
                   1397: 
                   1398:        liberation(s_etat_processus, s_objet_argument);
                   1399: 
                   1400:        if ((*s_etat_processus).s_liste_variables
                   1401:                [(*s_etat_processus).position_variable_courante]
                   1402:                .variable_verrouillee == d_vrai)
                   1403:        {
                   1404:            (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
                   1405:            return;
                   1406:        }
                   1407: 
                   1408:        if ((*s_etat_processus).s_liste_variables
                   1409:                [(*s_etat_processus).position_variable_courante].objet
                   1410:                == NULL)
                   1411:        {
                   1412:            if (pthread_mutex_lock(&((*(*s_etat_processus)
                   1413:                    .s_liste_variables_partagees).mutex)) != 0)
                   1414:            {
                   1415:                (*s_etat_processus).erreur_systeme = d_es_processus;
                   1416:                return;
                   1417:            }
                   1418: 
                   1419:            if (recherche_variable_partagee(s_etat_processus,
                   1420:                    (*s_etat_processus).s_liste_variables
                   1421:                    [(*s_etat_processus).position_variable_courante].nom,
                   1422:                    (*s_etat_processus).s_liste_variables
                   1423:                    [(*s_etat_processus).position_variable_courante]
                   1424:                    .variable_partagee, (*s_etat_processus).s_liste_variables
                   1425:                    [(*s_etat_processus).position_variable_courante]
                   1426:                    .origine) == d_faux)
                   1427:            {
                   1428:                (*s_etat_processus).erreur_systeme = d_es;
                   1429:                (*s_etat_processus).erreur_execution =
                   1430:                        d_ex_variable_non_definie;
                   1431: 
                   1432:                return;
                   1433:            }
                   1434: 
                   1435:            s_objet_argument = (*(*s_etat_processus)
                   1436:                    .s_liste_variables_partagees).table
                   1437:                    [(*(*s_etat_processus).s_liste_variables_partagees)
                   1438:                    .position_variable].objet;
                   1439:            variable_partagee = d_vrai;
                   1440:        }
                   1441:        else
                   1442:        {
                   1443:            s_objet_argument = (*s_etat_processus).s_liste_variables
                   1444:                    [(*s_etat_processus).position_variable_courante].objet;
                   1445:            variable_partagee = d_faux;
                   1446:        }
                   1447: 
                   1448:        if ((s_copie_argument = copie_objet(s_etat_processus,
                   1449:                s_objet_argument, 'O')) == NULL)
                   1450:        {
                   1451:            if (variable_partagee == d_vrai)
                   1452:            {
                   1453:                if (pthread_mutex_unlock(&((*(*s_etat_processus)
                   1454:                        .s_liste_variables_partagees).mutex)) != 0)
                   1455:                {
                   1456:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                   1457:                    return;
                   1458:                }
                   1459:            }
                   1460: 
                   1461:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1462:            return;
                   1463:        }
                   1464: 
                   1465:        liberation(s_etat_processus, s_objet_argument);
                   1466: 
                   1467:        if (variable_partagee == d_vrai)
                   1468:        {
                   1469:            (*s_etat_processus).s_liste_variables[(*s_etat_processus)
                   1470:                    .position_variable_courante].objet = NULL;
                   1471:            (*(*s_etat_processus)
                   1472:                    .s_liste_variables_partagees).table
                   1473:                    [(*(*s_etat_processus).s_liste_variables_partagees)
                   1474:                    .position_variable].objet = s_copie_argument;
                   1475:        }
                   1476:        else
                   1477:        {
                   1478:            (*s_etat_processus).s_liste_variables[(*s_etat_processus)
                   1479:                    .position_variable_courante].objet = s_copie_argument;
                   1480:        }
                   1481: 
                   1482:        if ((*s_copie_argument).type == INT)
                   1483:        {
                   1484:            (*((integer8 *) (*s_copie_argument).objet))++;
                   1485: 
                   1486:            if (variable_partagee == d_vrai)
                   1487:            {
                   1488:                if (pthread_mutex_unlock(&((*(*s_etat_processus)
                   1489:                        .s_liste_variables_partagees).mutex)) != 0)
                   1490:                {
                   1491:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                   1492:                    return;
                   1493:                }
                   1494:            }
                   1495:        }
                   1496:        else
                   1497:        {
                   1498:            if (variable_partagee == d_vrai)
                   1499:            {
                   1500:                if (pthread_mutex_unlock(&((*(*s_etat_processus)
                   1501:                        .s_liste_variables_partagees).mutex)) != 0)
                   1502:                {
                   1503:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                   1504:                    return;
                   1505:                }
                   1506:            }
                   1507: 
                   1508:            (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1509:            return;
                   1510:        }
                   1511:    }
                   1512:    else
                   1513:    {
                   1514:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1515: 
                   1516:        liberation(s_etat_processus, s_objet_argument);
                   1517:        return;
                   1518:    }
                   1519: 
                   1520:    return;
                   1521: }
                   1522: 
                   1523: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>