File:  [local] / rpl / src / instructions_i2.c
Revision 1.19: download - view: text, annotated - select for diffs - revision graph
Thu Jun 9 14:48:36 2011 UTC (12 years, 10 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Suite des modifications de la gestion des variables...

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

CVSweb interface <joel.bertrand@systella.fr>