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

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

CVSweb interface <joel.bertrand@systella.fr>