File:  [local] / rpl / src / instructions_i2.c
Revision 1.13: download - view: text, annotated - select for diffs - revision graph
Thu Aug 26 19:07:38 2010 UTC (13 years, 8 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_0_19, HEAD
En route pour la 4.0.19 !

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.19
    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>