File:  [local] / rpl / src / instructions_f3.c
Revision 1.46: download - view: text, annotated - select for diffs - revision graph
Fri Jun 22 10:12:19 2012 UTC (11 years, 10 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Refonte des formats d'écriture et de lecture pour les fichiers et les sockets.
Les objets de type FLOW sont maintenant obligés de signaler la longueur
des champs en lecture et en écriture grâce au format LENGTH*(*) ou LENGTH*(n).
Attention, ce code n'a pas encore été testé en production.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.9
    4:   Copyright (C) 1989-2012 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 'FORMAT'
   29: ================================================================================
   30:   Entrées : structure processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_format(struct_processus *s_etat_processus)
   40: {
   41:     struct_objet                *s_copie_argument_1;
   42:     struct_objet                *s_objet_argument_1;
   43:     struct_objet                *s_objet_argument_2;
   44: 
   45:     (*s_etat_processus).erreur_execution = d_ex;
   46: 
   47:     if ((*s_etat_processus).affichage_arguments == 'Y')
   48:     {
   49:         printf("\n  FORMAT ");
   50: 
   51:         if ((*s_etat_processus).langue == 'F')
   52:         {
   53:             printf("(associe un format à un descripteur de fichier "
   54:                     "ou à une socket)\n\n");
   55:         }
   56:         else
   57:         {
   58:             printf("(associate a format to a file or socket descriptor)\n\n");
   59:         }
   60: 
   61:         printf("    2: %s\n", d_LST);
   62:         printf("    1: %s, %s\n", d_FCH, d_SCK);
   63:         printf("->  1: %s, %s\n\n", d_FCH, d_SCK);
   64: 
   65:         if ((*s_etat_processus).langue == 'F')
   66:         {
   67:             printf("  Utilisation :\n\n");
   68:         }
   69:         else
   70:         {
   71:             printf("  Usage:\n\n");
   72:         }
   73: 
   74:         printf("    { \"STANDARD*(*)\" }\n");
   75:         printf("    { \"lambda\" 'SEQUENTIAL' 'NEW' 'WRITEONLY' 'FORMATTED' }"
   76:                 " OPEN FORMAT\n\n");
   77: 
   78:         if ((*s_etat_processus).langue == 'F')
   79:         {
   80:             printf("  Formats autorisés :\n\n");
   81:         }
   82:         else
   83:         {
   84:             printf("  Authorized formats:\n\n");
   85:         }
   86: 
   87:         printf("  FORMATTED\n");
   88:         printf("    { \"STANDARD*(*)\" }\n");
   89:         printf("    { \"STANDARD*(%s)\" }\n", d_INT);
   90:         printf("    { \"FIXED*%s(*)\" }\n", d_INT);
   91:         printf("    { \"FIXED*%s(%s)}\n", d_INT, d_INT);
   92:         printf("    { \"SCIENTIFIC*%s(*)\" }\n", d_INT);
   93:         printf("    { \"SCIENTIFIC*%s(%s)\" }\n", d_INT, d_INT);
   94:         printf("    { \"ENGINEER*%s(*)\" }\n", d_INT);
   95:         printf("    { \"ENGINEER*%s(%s)\" }\n", d_INT, d_INT);
   96:         printf("    { \"CHARACTER*(*)\" }\n");
   97:         printf("    { \"CHARACTER*(%s)\" }\n", d_INT);
   98:         printf("    { \"BINARY*%s(*)\" }\n", d_INT);
   99:         printf("    { \"BINARY*%s(%s)\" }\n\n", d_INT, d_INT);
  100: 
  101:         printf("  UNFORMATTED\n");
  102:         printf("    { \"INTEGER*1\", \"INTEGER*2\", \"INTEGER*4\", "
  103:                 "\"INTEGER*8\" }\n");
  104:         printf("    { \"LOGICAL*1\", \"LOGICAL*2\", \"LOGICAL*4\", "
  105:                 "\"LOGICAL*8\" }\n");
  106:         printf("    { \"REAL*4\", \"REAL*8\" }\n");
  107:         printf("    { \"COMPLEX*8\", \"COMPLEX*16\" }\n");
  108:         printf("    { \"CHARACTER\" }\n\n");
  109: 
  110:         printf("  FLOW\n");
  111:         printf("    { \"LENGTH*(*)\" }\n");
  112:         printf("    { \"LENGTH*(%s)\" }\n", d_INT);
  113: 
  114:         return;
  115:     }
  116:     else if ((*s_etat_processus).test_instruction == 'Y')
  117:     {
  118:         (*s_etat_processus).nombre_arguments = -1;
  119:         return;
  120:     }
  121: 
  122:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  123:     {
  124:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
  125:         {
  126:             return;
  127:         }
  128:     }
  129: 
  130:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  131:             &s_objet_argument_1) == d_erreur)
  132:     {
  133:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  134:         return;
  135:     }
  136: 
  137:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  138:             &s_objet_argument_2) == d_erreur)
  139:     {
  140:         liberation(s_etat_processus, s_objet_argument_1);
  141: 
  142:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  143:         return;
  144:     }
  145: 
  146:     if (((*s_objet_argument_1).type == FCH) &&
  147:             ((*s_objet_argument_2).type == LST))
  148:     {
  149:         if ((*((struct_fichier *) (*s_objet_argument_1).objet)).binaire
  150:                 == 'F')
  151:         {
  152:             liberation(s_etat_processus, s_objet_argument_1);
  153:             liberation(s_etat_processus, s_objet_argument_2);
  154: 
  155:             (*s_etat_processus).erreur_execution =
  156:                     d_ex_erreur_format_fichier;
  157:             return;
  158:         }
  159: 
  160:         if ((s_copie_argument_1 = copie_objet(s_etat_processus,
  161:                 s_objet_argument_1, 'N')) == NULL)
  162:         {
  163:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  164:             return;
  165:         }
  166: 
  167:         liberation(s_etat_processus, s_objet_argument_1);
  168:         s_objet_argument_1 = s_copie_argument_1;
  169: 
  170:         liberation(s_etat_processus, (*((struct_fichier *)
  171:                 (*s_objet_argument_1).objet)).format);
  172: 
  173:         (*((struct_fichier *) (*s_objet_argument_1).objet)).format =
  174:                 s_objet_argument_2;
  175:     }
  176:     else if (((*s_objet_argument_1).type == SCK) &&
  177:             ((*s_objet_argument_2).type == LST))
  178:     {
  179:         if ((*((struct_socket *) (*s_objet_argument_1).objet)).binaire
  180:                 == 'F')
  181:         {
  182:             liberation(s_etat_processus, s_objet_argument_1);
  183:             liberation(s_etat_processus, s_objet_argument_2);
  184: 
  185:             (*s_etat_processus).erreur_execution =
  186:                     d_ex_erreur_format_fichier;
  187:             return;
  188:         }
  189: 
  190:         if ((s_copie_argument_1 = copie_objet(s_etat_processus,
  191:                 s_objet_argument_1, 'N')) == NULL)
  192:         {
  193:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  194:             return;
  195:         }
  196: 
  197:         liberation(s_etat_processus, s_objet_argument_1);
  198:         s_objet_argument_1 = s_copie_argument_1;
  199: 
  200:         liberation(s_etat_processus, (*((struct_socket *)
  201:                 (*s_objet_argument_1).objet)).format);
  202: 
  203:         (*((struct_socket *) (*s_objet_argument_1).objet)).format =
  204:                 s_objet_argument_2;
  205:     }
  206:     else
  207:     {
  208:         liberation(s_etat_processus, s_objet_argument_1);
  209:         liberation(s_etat_processus, s_objet_argument_2);
  210: 
  211:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  212:         return;
  213:     }
  214: 
  215:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  216:             s_objet_argument_1) == d_erreur)
  217:     {
  218:         return;
  219:     }
  220: 
  221:     return;
  222: }
  223: 
  224: 
  225: /*
  226: ================================================================================
  227:   Fonction '->LCD'
  228: ================================================================================
  229:   Entrées : structure processus
  230: --------------------------------------------------------------------------------
  231:   Sorties :
  232: --------------------------------------------------------------------------------
  233:   Effets de bord : néant
  234: ================================================================================
  235: */
  236: 
  237: void
  238: instruction_fleche_lcd(struct_processus *s_etat_processus)
  239: {
  240:     file                        *fichier_destination;
  241:     file                        *fichier_source;
  242: 
  243:     int                         caractere;
  244:     int                         dimensions;
  245: 
  246:     integer8                    systeme_axes;
  247: 
  248:     logical1                    axes;
  249: 
  250:     struct_fichier_graphique    *l_fichier_courant;
  251: 
  252:     struct_objet                *s_objet_argument;
  253: 
  254:     unsigned char               drapeau_axes;
  255:     unsigned char               *nom_fichier;
  256:     unsigned char               type[21];
  257: 
  258:     (*s_etat_processus).erreur_execution = d_ex;
  259: 
  260:     if ((*s_etat_processus).affichage_arguments == 'Y')
  261:     {
  262:         printf("\n  ->LCD ");
  263: 
  264:         if ((*s_etat_processus).langue == 'F')
  265:         {
  266:             printf("(lecture d'un fichier graphique)\n\n");
  267:         }
  268:         else
  269:         {
  270:             printf("(read a graphical file)\n\n");
  271:         }
  272: 
  273:         printf("    1: %s\n", d_CHN);
  274: 
  275:         return;
  276:     }
  277:     else if ((*s_etat_processus).test_instruction == 'Y')
  278:     {
  279:         (*s_etat_processus).nombre_arguments = -1;
  280:         return;
  281:     }
  282: 
  283:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  284:     {
  285:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  286:         {
  287:             return;
  288:         }
  289:     }
  290: 
  291:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  292:             &s_objet_argument) == d_erreur)
  293:     {
  294:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  295:         return;
  296:     }
  297: 
  298:     if ((*s_objet_argument).type == CHN)
  299:     {
  300:         if (fflush(NULL) != 0)
  301:         {
  302:             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  303:             return;
  304:         }
  305: 
  306:         if ((fichier_source = fopen((unsigned char *) (*s_objet_argument).objet,
  307:                 "r")) == NULL)
  308:         {
  309:             liberation(s_etat_processus, s_objet_argument);
  310: 
  311:             (*s_etat_processus).erreur_execution = d_ex_erreur_fichier;
  312:             return;
  313:         }
  314: 
  315:         fichier_destination = NULL;
  316: 
  317:         while((caractere = getc(fichier_source)) != EOF)
  318:         {
  319:             if (caractere == '@')
  320:             {
  321:                 /* Création d'un nouveau fichier */
  322: 
  323:                 if (fichier_destination != NULL)
  324:                 {
  325:                     if (fclose(fichier_destination) != 0)
  326:                     {
  327:                         (*s_etat_processus).erreur_systeme =
  328:                                 d_es_erreur_fichier;
  329:                         return;
  330:                     }
  331:                 }
  332: 
  333:                 if (fscanf(fichier_source, " %c %d %lld %s",
  334:                         &drapeau_axes, &dimensions, &systeme_axes, type) != 4)
  335:                 {
  336:                     (*s_etat_processus).erreur_systeme =
  337:                             d_es_erreur_fichier;
  338:                     return;
  339:                 }
  340: 
  341:                 axes = (drapeau_axes == 'T') ? d_vrai : d_faux;
  342: 
  343:                 if ((nom_fichier = creation_nom_fichier(s_etat_processus,
  344:                         (*s_etat_processus).chemin_fichiers_temporaires))
  345:                         == NULL)
  346:                 {
  347:                     (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  348:                     return;
  349:                 }
  350: 
  351:                 if ((fichier_destination = fopen(nom_fichier, "w")) == NULL)
  352:                 {
  353:                     (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  354:                     return;
  355:                 }
  356: 
  357:                 /* Chaînage */
  358: 
  359:                 l_fichier_courant = (*s_etat_processus).fichiers_graphiques;
  360: 
  361:                 if (l_fichier_courant == NULL)
  362:                 {
  363:                     if (((*s_etat_processus).fichiers_graphiques =
  364:                             malloc(sizeof(struct_fichier_graphique))) == NULL)
  365:                     {
  366:                         (*s_etat_processus).erreur_systeme =
  367:                                 d_es_allocation_memoire;
  368:                         return;
  369:                     }
  370: 
  371:                     (*(*s_etat_processus).fichiers_graphiques).suivant = NULL;
  372:                     (*(*s_etat_processus).fichiers_graphiques).nom =
  373:                             nom_fichier;
  374:                     (*(*s_etat_processus).fichiers_graphiques).legende =
  375:                             NULL;
  376:                     (*(*s_etat_processus).fichiers_graphiques).presence_axes =
  377:                             axes;
  378:                     (*(*s_etat_processus).fichiers_graphiques).dimensions =
  379:                             dimensions;
  380:                     (*(*s_etat_processus).fichiers_graphiques).systeme_axes =
  381:                             systeme_axes;
  382:                     strcpy((*(*s_etat_processus).fichiers_graphiques).type,
  383:                             type);
  384:                 }
  385:                 else
  386:                 {
  387:                     while((*l_fichier_courant).suivant != NULL)
  388:                     {
  389:                         l_fichier_courant = (*l_fichier_courant).suivant;
  390:                     }
  391: 
  392:                     if (((*l_fichier_courant).suivant =
  393:                             malloc(sizeof(struct_fichier_graphique))) == NULL)
  394:                     {
  395:                         (*s_etat_processus).erreur_systeme =
  396:                                 d_es_allocation_memoire;
  397:                         return;
  398:                     }
  399: 
  400:                     l_fichier_courant = (*l_fichier_courant).suivant;
  401: 
  402:                     (*l_fichier_courant).suivant = NULL;
  403:                     (*l_fichier_courant).nom = nom_fichier;
  404:                     (*l_fichier_courant).legende = NULL;
  405:                     (*l_fichier_courant).presence_axes = axes;
  406:                     (*l_fichier_courant).dimensions = dimensions;
  407:                     (*l_fichier_courant).systeme_axes = systeme_axes;
  408:                     strcpy((*l_fichier_courant).type, type);
  409:                 }
  410:             }
  411:             else
  412:             {
  413:                 if (putc(caractere, fichier_destination) == EOF)
  414:                 {
  415:                     (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  416:                     return;
  417:                 }
  418:             }
  419:         }
  420: 
  421:         if (fichier_destination != NULL)
  422:         {
  423:             if (fclose(fichier_destination) != 0)
  424:             {
  425:                 (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  426:                 return;
  427:             }
  428:         }
  429: 
  430:         if (fclose(fichier_source) != 0)
  431:         {
  432:             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  433:             return;
  434:         }
  435:     }
  436:     else
  437:     {
  438:         liberation(s_etat_processus, s_objet_argument);
  439: 
  440:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  441:         return;
  442:     }
  443: 
  444:     liberation(s_etat_processus, s_objet_argument);
  445: 
  446:     appel_gnuplot(s_etat_processus, 'N');
  447: 
  448:     return;
  449: }
  450: 
  451: 
  452: /*
  453: ================================================================================
  454:   Fonction '->Q'
  455: ================================================================================
  456:   Entrées : structure processus
  457: --------------------------------------------------------------------------------
  458:   Sorties :
  459: --------------------------------------------------------------------------------
  460:   Effets de bord : néant
  461: ================================================================================
  462: */
  463: 
  464: void
  465: instruction_fleche_q(struct_processus *s_etat_processus)
  466: {
  467:     double                      epsilon;
  468: 
  469:     struct_liste_chainee        *l_element_courant;
  470: 
  471:     struct_objet                *s_objet_argument;
  472:     struct_objet                *s_objet_argument_1;
  473:     struct_objet                *s_objet_argument_2;
  474:     struct_objet                *s_objet_resultat;
  475: 
  476:     real8                       f;
  477:     real8                       objectif;
  478:     real8                       r1;
  479:     real8                       r2;
  480:     real8                       s1;
  481:     real8                       s2;
  482:     real8                       t1;
  483:     real8                       t2;
  484:     real8                       x;
  485:     real8                       y;
  486:     real8                       z;
  487: 
  488:     (*s_etat_processus).erreur_execution = d_ex;
  489: 
  490:     if ((*s_etat_processus).affichage_arguments == 'Y')
  491:     {
  492:         printf("\n  ->Q ");
  493: 
  494:         if ((*s_etat_processus).langue == 'F')
  495:         {
  496:             printf("(transformation d'un réel en rationnel)\n\n");
  497:         }
  498:         else
  499:         {
  500:             printf("(transform a real into a rational)\n\n");
  501:         }
  502: 
  503:         printf("    1: %s\n", d_INT);
  504:         printf("->  1: %s\n\n", d_INT);
  505: 
  506:         printf("    1: %s\n", d_REL);
  507:         printf("->  1: %s\n", d_ALG);
  508: 
  509:         return;
  510:     }
  511:     else if ((*s_etat_processus).test_instruction == 'Y')
  512:     {
  513:         (*s_etat_processus).nombre_arguments = -1;
  514:         return;
  515:     }
  516: 
  517:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  518:     {
  519:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  520:         {
  521:             return;
  522:         }
  523:     }
  524: 
  525:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  526:             &s_objet_argument) == d_erreur)
  527:     {
  528:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  529:         return;
  530:     }
  531: 
  532:     if ((*s_objet_argument).type == INT)
  533:     {
  534:         s_objet_resultat = s_objet_argument;
  535:         s_objet_argument = NULL;
  536:     }
  537:     else if ((*s_objet_argument).type == REL)
  538:     {
  539:         x = (*((real8 *) (*s_objet_argument).objet));
  540:         objectif = x;
  541:         epsilon = nextafter(-abs(x), 0) + abs(x);
  542: 
  543:         r1 = 1;
  544:         r2 = 0;
  545:         s1 = 0;
  546:         s2 = 1;
  547: 
  548:         do
  549:         {
  550:             f = floor(x);
  551: 
  552:             t1 = r1;
  553:             t2 = r2;
  554: 
  555:             r1 = (f * r1) + s1;
  556:             r2 = (f * r2) + s2;
  557: 
  558:             s1 = t1;
  559:             s2 = t2;
  560: 
  561:             y = x - f;
  562: 
  563:             if (y != 0)
  564:             {
  565:                 z = fabs(objectif - (r1 / r2));
  566:                 x = ((real8) 1) / y;
  567:             }
  568:             else
  569:             {
  570:                 z = 0;
  571:             }
  572:         } while(z > epsilon);
  573: 
  574:         if (r2 != ((real8) ((integer8) r2)))
  575:         {
  576:             if ((s_objet_argument_1 = allocation(s_etat_processus, REL))
  577:                     == NULL)
  578:             {
  579:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  580:                 return;
  581:             }
  582: 
  583:             (*((real8 *) (*s_objet_argument_1).objet)) = r2;
  584:         }
  585:         else
  586:         {
  587:             if ((s_objet_argument_1 = allocation(s_etat_processus, INT))
  588:                     == NULL)
  589:             {
  590:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  591:                 return;
  592:             }
  593: 
  594:             (*((integer8 *) (*s_objet_argument_1).objet)) = (integer8) r2;
  595:         }
  596: 
  597:         if (r1 != ((real8) ((integer8) r1)))
  598:         {
  599:             if ((s_objet_argument_2 = allocation(s_etat_processus, REL))
  600:                     == NULL)
  601:             {
  602:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  603:                 return;
  604:             }
  605: 
  606:             (*((real8 *) (*s_objet_argument_2).objet)) = r1;
  607:         }
  608:         else
  609:         {
  610:             if ((s_objet_argument_2 = allocation(s_etat_processus, INT))
  611:                     == NULL)
  612:             {
  613:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  614:                 return;
  615:             }
  616: 
  617:             (*((integer8 *) (*s_objet_argument_2).objet)) = (integer8) r1;
  618:         }
  619: 
  620:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
  621:         {
  622:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  623:             return;
  624:         }
  625: 
  626:         if (((*s_objet_resultat).objet =
  627:                 allocation_maillon(s_etat_processus)) == NULL)
  628:         {
  629:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  630:             return;
  631:         }
  632: 
  633:         l_element_courant = (*s_objet_resultat).objet;
  634: 
  635:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  636:                 == NULL)
  637:         {
  638:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  639:             return;
  640:         }
  641: 
  642:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  643:                 .nombre_arguments = 0;
  644:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  645:                 .fonction = instruction_vers_niveau_superieur;
  646: 
  647:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  648:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  649:         {
  650:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  651:             return;
  652:         }
  653: 
  654:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  655:                 .nom_fonction, "<<");
  656: 
  657:         if (((*l_element_courant).suivant =
  658:                 allocation_maillon(s_etat_processus)) == NULL)
  659:         {
  660:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  661:             return;
  662:         }
  663: 
  664:         l_element_courant = (*l_element_courant).suivant;
  665:         (*l_element_courant).donnee = s_objet_argument_2;
  666: 
  667:         if (((*l_element_courant).suivant =
  668:                 allocation_maillon(s_etat_processus)) == NULL)
  669:         {
  670:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  671:             return;
  672:         }
  673: 
  674:         l_element_courant = (*l_element_courant).suivant;
  675:         (*l_element_courant).donnee = s_objet_argument_1;
  676: 
  677:         if (((*l_element_courant).suivant =
  678:                 allocation_maillon(s_etat_processus)) == NULL)
  679:         {
  680:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  681:             return;
  682:         }
  683: 
  684:         l_element_courant = (*l_element_courant).suivant;
  685: 
  686:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  687:                 == NULL)
  688:         {
  689:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  690:             return;
  691:         }
  692: 
  693:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  694:                 .nombre_arguments = 0;
  695:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  696:                 .fonction = instruction_division;
  697: 
  698:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  699:                 .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
  700:         {
  701:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  702:             return;
  703:         }
  704: 
  705:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  706:                 .nom_fonction, "/");
  707: 
  708:         if (((*l_element_courant).suivant =
  709:                 allocation_maillon(s_etat_processus)) == NULL)
  710:         {
  711:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  712:             return;
  713:         }
  714: 
  715:         l_element_courant = (*l_element_courant).suivant;
  716: 
  717:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  718:                 == NULL)
  719:         {
  720:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  721:             return;
  722:         }
  723: 
  724:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  725:                 .nombre_arguments = 0;
  726:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  727:                 .fonction = instruction_vers_niveau_inferieur;
  728: 
  729:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  730:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  731:         {
  732:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  733:             return;
  734:         }
  735: 
  736:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  737:                 .nom_fonction, ">>");
  738: 
  739:         (*l_element_courant).suivant = NULL;
  740: 
  741:         s_objet_argument_1 = NULL;
  742:         s_objet_argument_2 = NULL;
  743: 
  744:         liberation(s_etat_processus, s_objet_argument_1);
  745:         liberation(s_etat_processus, s_objet_argument_2);
  746:     }
  747:     else
  748:     {
  749:         liberation(s_etat_processus, s_objet_argument);
  750: 
  751:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  752:         return;
  753:     }
  754: 
  755:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  756:             s_objet_resultat) == d_erreur)
  757:     {
  758:         return;
  759:     }
  760: 
  761:     liberation(s_etat_processus, s_objet_argument);
  762: 
  763:     return;
  764: }
  765: 
  766: 
  767: /*
  768: ================================================================================
  769:   Fonction '->ROW'
  770: ================================================================================
  771:   Entrées : structure processus
  772: --------------------------------------------------------------------------------
  773:   Sorties :
  774: --------------------------------------------------------------------------------
  775:   Effets de bord : néant
  776: ================================================================================
  777: */
  778: 
  779: void
  780: instruction_fleche_row(struct_processus *s_etat_processus)
  781: {
  782:     integer8                        i;
  783:     integer8                        j;
  784:     integer8                        nombre_colonnes;
  785:     integer8                        nombre_lignes;
  786: 
  787:     struct_liste_chainee            *l_element_courant;
  788: 
  789:     struct_objet                    *s_objet;
  790:     struct_objet                    *s_objet_resultat;
  791: 
  792:     unsigned char                   type;
  793: 
  794:     (*s_etat_processus).erreur_execution = d_ex;
  795: 
  796:     if ((*s_etat_processus).affichage_arguments == 'Y')
  797:     {
  798:         printf("\n  ->ROW ");
  799: 
  800:         if ((*s_etat_processus).langue == 'F')
  801:         {
  802:             printf("(construction d'une matrice à partir de ses lignes)\n\n");
  803:         }
  804:         else
  805:         {
  806:             printf("(build a matrix from rows)\n\n");
  807:         }
  808: 
  809:         printf("    n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
  810:         printf("    ...\n");
  811:         printf("    2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
  812:         printf("    1: %s\n", d_INT);
  813:         printf("->  1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
  814: 
  815:         return;
  816:     }
  817:     else if ((*s_etat_processus).test_instruction == 'Y')
  818:     {
  819:         (*s_etat_processus).nombre_arguments = -1;
  820:         return;
  821:     }
  822: 
  823:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  824:     {
  825:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  826:         {
  827:             return;
  828:         }
  829:     }
  830: 
  831:     if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
  832:     {
  833:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  834:         return;
  835:     }
  836: 
  837:     if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
  838:     {
  839:         (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  840:         return;
  841:     }
  842: 
  843:     nombre_lignes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
  844:             .donnee).objet));
  845: 
  846:     if (nombre_lignes <= 0)
  847:     {
  848:         /*
  849:          * Nombre lignes négatif ou nul, l'opération est absurde.
  850:          */
  851: 
  852:         (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  853:         return;
  854:     }
  855: 
  856:     if (nombre_lignes >= (integer8) (*s_etat_processus)
  857:             .hauteur_pile_operationnelle)
  858:     {
  859:          (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  860:          return;
  861:     }
  862: 
  863:     /*
  864:      * Traitement de la pile last le cas échéant.
  865:      */
  866: 
  867:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  868:     {
  869:         if (empilement_pile_last(s_etat_processus, nombre_lignes + 1)
  870:                 == d_erreur)
  871:         {
  872:             return;
  873:         }
  874:     }
  875: 
  876:     /*
  877:      * Retrait de l'objet indiquant le nombre de lignes.
  878:      */
  879: 
  880:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  881:             &s_objet) == d_erreur)
  882:     {
  883:         return;
  884:     }
  885: 
  886:     liberation(s_etat_processus, s_objet);
  887: 
  888:     /*
  889:      * Recherche du type de la matrice finale.
  890:      */
  891: 
  892:     type = 'I';
  893:     l_element_courant = (*s_etat_processus).l_base_pile;
  894:     nombre_colonnes = 0;
  895: 
  896:     for(i = 0; i < nombre_lignes; i++)
  897:     {
  898:         if (((*(*l_element_courant).donnee).type != MIN) &&
  899:                 ((*(*l_element_courant).donnee).type != MRL) &&
  900:                 ((*(*l_element_courant).donnee).type != MCX))
  901:         {
  902:             /*
  903:              * Problème : on vient de tirer autre chose qu'une matrice
  904:              * dans la pile.
  905:              */
  906: 
  907:             (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  908:             return;
  909:         }
  910: 
  911:         if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet))
  912:                 .nombre_lignes != 1)
  913:         {
  914:             /*
  915:              * La matrice n'est pas une matrice ligne.
  916:              */
  917: 
  918:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  919:             return;
  920:         }
  921: 
  922:         if (i == 0)
  923:         {
  924:             nombre_colonnes = (*((struct_matrice *) (*(*l_element_courant)
  925:                     .donnee).objet)).nombre_colonnes;
  926:         }
  927:         else
  928:         {
  929:             if (nombre_colonnes != (integer8) (*((struct_matrice *)
  930:                     (*(*l_element_courant).donnee).objet)).nombre_colonnes)
  931:             {
  932:                 /*
  933:                  * La dernière matrice observée n'a pas les mêmes dimensions
  934:                  * (nombre de colonnes) que les précédentes.
  935:                  */
  936: 
  937:                 (*s_etat_processus).erreur_execution =
  938:                         d_ex_dimensions_invalides;
  939:                 return;
  940:             }
  941:         }
  942: 
  943:         if (type == 'I')
  944:         {
  945:             if ((*(*l_element_courant).donnee).type == MRL)
  946:             {
  947:                 type = 'R';
  948:             }
  949:             else if ((*(*l_element_courant).donnee).type == MCX)
  950:             {
  951:                 type = 'C';
  952:             }
  953:         }
  954:         else if (type == 'R')
  955:         {
  956:             if ((*(*l_element_courant).donnee).type == MCX)
  957:             {
  958:                 type = 'C';
  959:             }
  960:         }
  961: 
  962:         l_element_courant = (*l_element_courant).suivant;
  963:     }
  964: 
  965:     if (type == 'I')
  966:     {
  967:         if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
  968:         {
  969:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  970:             return;
  971:         }
  972: 
  973:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
  974:                 nombre_colonnes;
  975:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
  976:                 nombre_lignes;
  977: 
  978:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
  979:                 malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
  980:         {
  981:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  982:             return;
  983:         }
  984: 
  985:         for(i = nombre_lignes - 1; i >= 0; i--)
  986:         {
  987:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  988:                     &s_objet) == d_erreur)
  989:             {
  990:                 return;
  991:             }
  992: 
  993:             if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
  994:                     .objet)).tableau)[i] = malloc(nombre_colonnes *
  995:                     sizeof(integer8))) == NULL)
  996:             {
  997:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  998:                 return;
  999:             }
 1000: 
 1001:             for(j = 0; j < nombre_colonnes; j++)
 1002:             {
 1003:                 ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
 1004:                         .objet)).tableau)[i][j] = ((integer8 **)
 1005:                         (*((struct_matrice *) (*s_objet).objet)).tableau)[0][j];
 1006:             }
 1007: 
 1008:             liberation(s_etat_processus, s_objet);
 1009:         }
 1010:     }
 1011:     else if (type == 'R')
 1012:     {
 1013:         if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
 1014:         {
 1015:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1016:             return;
 1017:         }
 1018: 
 1019:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
 1020:                 nombre_colonnes;
 1021:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
 1022:                 nombre_lignes;
 1023: 
 1024:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
 1025:                 malloc(nombre_lignes * sizeof(real8 *))) == NULL)
 1026:         {
 1027:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1028:             return;
 1029:         }
 1030: 
 1031:         for(i = nombre_lignes - 1; i >= 0; i--)
 1032:         {
 1033:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1034:                     &s_objet) == d_erreur)
 1035:             {
 1036:                 return;
 1037:             }
 1038: 
 1039:             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
 1040:                     .objet)).tableau)[i] = malloc(nombre_colonnes *
 1041:                     sizeof(real8))) == NULL)
 1042:             {
 1043:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1044:                 return;
 1045:             }
 1046: 
 1047:             if ((*s_objet).type == MIN)
 1048:             {
 1049:                 for(j = 0; j < nombre_colonnes; j++)
 1050:                 {
 1051:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
 1052:                             .objet)).tableau)[i][j] = ((integer8 **)
 1053:                             (*((struct_matrice *) (*s_objet).objet))
 1054:                             .tableau)[0][j];
 1055:                 }
 1056:             }
 1057:             else
 1058:             {
 1059:                 for(j = 0; j < nombre_colonnes; j++)
 1060:                 {
 1061:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
 1062:                             .objet)).tableau)[i][j] = ((real8 **)
 1063:                             (*((struct_matrice *) (*s_objet).objet))
 1064:                             .tableau)[0][j];
 1065:                 }
 1066:             }
 1067: 
 1068:             liberation(s_etat_processus, s_objet);
 1069:         }
 1070:     }
 1071:     else
 1072:     {
 1073:         if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
 1074:         {
 1075:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1076:             return;
 1077:         }
 1078: 
 1079:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
 1080:                 nombre_colonnes;
 1081:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
 1082:                 nombre_lignes;
 1083: 
 1084:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
 1085:                 malloc(nombre_lignes * sizeof(complex16 *))) == NULL)
 1086:         {
 1087:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1088:             return;
 1089:         }
 1090: 
 1091:         for(i = nombre_lignes - 1; i >= 0; i--)
 1092:         {
 1093:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1094:                     &s_objet) == d_erreur)
 1095:             {
 1096:                 return;
 1097:             }
 1098: 
 1099:             if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1100:                     .objet)).tableau)[i] = malloc(nombre_colonnes *
 1101:                     sizeof(complex16))) == NULL)
 1102:             {
 1103:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1104:                 return;
 1105:             }
 1106: 
 1107:             if ((*s_objet).type == MIN)
 1108:             {
 1109:                 for(j = 0; j < nombre_colonnes; j++)
 1110:                 {
 1111:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1112:                             .objet)).tableau)[i][j]).partie_reelle =
 1113:                             ((integer8 **) (*((struct_matrice *)
 1114:                             (*s_objet).objet)).tableau)[0][j];
 1115:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1116:                             .objet)).tableau)[i][j]).partie_imaginaire = 0;
 1117:                 }
 1118:             }
 1119:             else if ((*s_objet).type == MRL)
 1120:             {
 1121:                 for(j = 0; j < nombre_colonnes; j++)
 1122:                 {
 1123:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1124:                             .objet)).tableau)[i][j]).partie_reelle =
 1125:                             ((real8 **) (*((struct_matrice *)
 1126:                             (*s_objet).objet)).tableau)[0][j];
 1127:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1128:                             .objet)).tableau)[i][j]).partie_imaginaire = 0;
 1129:                 }
 1130:             }
 1131:             else
 1132:             {
 1133:                 for(j = 0; j < nombre_colonnes; j++)
 1134:                 {
 1135:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1136:                             .objet)).tableau)[i][j]).partie_reelle =
 1137:                             (((complex16 **) (*((struct_matrice *)
 1138:                             (*s_objet).objet)).tableau)[0][j])
 1139:                             .partie_reelle;
 1140:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1141:                             .objet)).tableau)[i][j]).partie_imaginaire =
 1142:                             (((complex16 **) (*((struct_matrice *)
 1143:                             (*s_objet).objet)).tableau)[0][j])
 1144:                             .partie_imaginaire;
 1145:                 }
 1146:             }
 1147: 
 1148:             liberation(s_etat_processus, s_objet);
 1149:         }
 1150:     }
 1151: 
 1152:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1153:             s_objet_resultat) == d_erreur)
 1154:     {
 1155:         return;
 1156:     }
 1157: 
 1158:     return;
 1159: }
 1160: 
 1161: 
 1162: /*
 1163: ================================================================================
 1164:   Fonction '->COL'
 1165: ================================================================================
 1166:   Entrées : structure processus
 1167: --------------------------------------------------------------------------------
 1168:   Sorties :
 1169: --------------------------------------------------------------------------------
 1170:   Effets de bord : néant
 1171: ================================================================================
 1172: */
 1173: 
 1174: void
 1175: instruction_fleche_col(struct_processus *s_etat_processus)
 1176: {
 1177:     integer8                        i;
 1178:     integer8                        j;
 1179:     integer8                        nombre_colonnes;
 1180:     integer8                        nombre_lignes;
 1181: 
 1182:     struct_liste_chainee            *l_element_courant;
 1183: 
 1184:     struct_objet                    *s_objet;
 1185:     struct_objet                    *s_objet_resultat;
 1186: 
 1187:     unsigned char                   type;
 1188: 
 1189:     (*s_etat_processus).erreur_execution = d_ex;
 1190: 
 1191:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1192:     {
 1193:         printf("\n  ->COL ");
 1194: 
 1195:         if ((*s_etat_processus).langue == 'F')
 1196:         {
 1197:             printf("(construction d'une matrice à partir de ses colonnes)\n\n");
 1198:         }
 1199:         else
 1200:         {
 1201:             printf("(build a matrix from columns)\n\n");
 1202:         }
 1203: 
 1204:         printf("    n: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
 1205:         printf("    ...\n");
 1206:         printf("    2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
 1207:         printf("    1: %s\n", d_INT);
 1208:         printf("->  1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
 1209: 
 1210:         return;
 1211:     }
 1212:     else if ((*s_etat_processus).test_instruction == 'Y')
 1213:     {
 1214:         (*s_etat_processus).nombre_arguments = -1;
 1215:         return;
 1216:     }
 1217: 
 1218:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1219:     {
 1220:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1221:         {
 1222:             return;
 1223:         }
 1224:     }
 1225: 
 1226:     if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
 1227:     {
 1228:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1229:         return;
 1230:     }
 1231: 
 1232:     if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
 1233:     {
 1234:         (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1235:         return;
 1236:     }
 1237: 
 1238:     nombre_colonnes = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
 1239:             .donnee).objet));
 1240: 
 1241:     if (nombre_colonnes <= 0)
 1242:     {
 1243:         /*
 1244:          * Nombre lignes négatif ou nul, l'opération est absurde.
 1245:          */
 1246: 
 1247:         (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1248:         return;
 1249:     }
 1250: 
 1251:     if (nombre_colonnes >= (integer8) (*s_etat_processus)
 1252:             .hauteur_pile_operationnelle)
 1253:     {
 1254:          (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1255:          return;
 1256:     }
 1257: 
 1258:     /*
 1259:      * Traitement de la pile last le cas échéant.
 1260:      */
 1261: 
 1262:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1263:     {
 1264:         if (empilement_pile_last(s_etat_processus, nombre_colonnes + 1)
 1265:                 == d_erreur)
 1266:         {
 1267:             return;
 1268:         }
 1269:     }
 1270: 
 1271:     /*
 1272:      * Retrait de l'objet indiquant le nombre de lignes.
 1273:      */
 1274: 
 1275:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1276:             &s_objet) == d_erreur)
 1277:     {
 1278:         return;
 1279:     }
 1280: 
 1281:     liberation(s_etat_processus, s_objet);
 1282: 
 1283:     /*
 1284:      * Recherche du type de la matrice finale.
 1285:      */
 1286: 
 1287:     type = 'I';
 1288:     l_element_courant = (*s_etat_processus).l_base_pile;
 1289:     nombre_lignes = 0;
 1290: 
 1291:     for(i = 0; i < nombre_colonnes; i++)
 1292:     {
 1293:         if (((*(*l_element_courant).donnee).type != MIN) &&
 1294:                 ((*(*l_element_courant).donnee).type != MRL) &&
 1295:                 ((*(*l_element_courant).donnee).type != MCX))
 1296:         {
 1297:             /*
 1298:              * Problème : on vient de tirer autre chose qu'une matrice
 1299:              * dans la pile.
 1300:              */
 1301: 
 1302:             (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1303:             return;
 1304:         }
 1305: 
 1306:         if ((*((struct_matrice *) (*(*l_element_courant).donnee).objet))
 1307:                 .nombre_colonnes != 1)
 1308:         {
 1309:             /*
 1310:              * La matrice n'est pas une matrice colonne.
 1311:              */
 1312: 
 1313:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
 1314:             return;
 1315:         }
 1316: 
 1317:         if (i == 0)
 1318:         {
 1319:             nombre_lignes = (*((struct_matrice *) (*(*l_element_courant)
 1320:                     .donnee).objet)).nombre_lignes;
 1321:         }
 1322:         else
 1323:         {
 1324:             if (nombre_lignes != (integer8) (*((struct_matrice *)
 1325:                     (*(*l_element_courant).donnee).objet)).nombre_lignes)
 1326:             {
 1327:                 /*
 1328:                  * La dernière matrice observée n'a pas les mêmes dimensions
 1329:                  * (nombre de colonnes) que les précédentes.
 1330:                  */
 1331: 
 1332:                 (*s_etat_processus).erreur_execution =
 1333:                         d_ex_dimensions_invalides;
 1334:                 return;
 1335:             }
 1336:         }
 1337: 
 1338:         if (type == 'I')
 1339:         {
 1340:             if ((*(*l_element_courant).donnee).type == MRL)
 1341:             {
 1342:                 type = 'R';
 1343:             }
 1344:             else if ((*(*l_element_courant).donnee).type == MCX)
 1345:             {
 1346:                 type = 'C';
 1347:             }
 1348:         }
 1349:         else if (type == 'R')
 1350:         {
 1351:             if ((*(*l_element_courant).donnee).type == MCX)
 1352:             {
 1353:                 type = 'C';
 1354:             }
 1355:         }
 1356: 
 1357:         l_element_courant = (*l_element_courant).suivant;
 1358:     }
 1359: 
 1360:     if (type == 'I')
 1361:     {
 1362:         if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
 1363:         {
 1364:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1365:             return;
 1366:         }
 1367: 
 1368:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
 1369:                 nombre_colonnes;
 1370:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
 1371:                 nombre_lignes;
 1372: 
 1373:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
 1374:                 malloc(nombre_lignes * sizeof(integer8 *))) == NULL)
 1375:         {
 1376:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1377:             return;
 1378:         }
 1379: 
 1380:         for(i = 0; i < nombre_lignes; i++)
 1381:         {
 1382:             if ((((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
 1383:                     .objet)).tableau)[i] = malloc(nombre_colonnes *
 1384:                     sizeof(integer8))) == NULL)
 1385:             {
 1386:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1387:                 return;
 1388:             }
 1389:         }
 1390: 
 1391:         for(j = nombre_colonnes - 1; j >= 0; j--)
 1392:         {
 1393:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1394:                     &s_objet) == d_erreur)
 1395:             {
 1396:                 return;
 1397:             }
 1398: 
 1399:             for(i = 0; i < nombre_lignes; i++)
 1400:             {
 1401:                 ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
 1402:                         .objet)).tableau)[i][j] = ((integer8 **)
 1403:                         (*((struct_matrice *) (*s_objet).objet)).tableau)[i][0];
 1404:             }
 1405: 
 1406:             liberation(s_etat_processus, s_objet);
 1407:         }
 1408:     }
 1409:     else if (type == 'R')
 1410:     {
 1411:         if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
 1412:         {
 1413:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1414:             return;
 1415:         }
 1416: 
 1417:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
 1418:                 nombre_colonnes;
 1419:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
 1420:                 nombre_lignes;
 1421: 
 1422:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
 1423:                 malloc(nombre_lignes * sizeof(real8 *))) == NULL)
 1424:         {
 1425:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1426:             return;
 1427:         }
 1428: 
 1429:         for(i = 0; i < nombre_lignes; i++)
 1430:         {
 1431:             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat)
 1432:                     .objet)).tableau)[i] = malloc(nombre_colonnes *
 1433:                     sizeof(real8))) == NULL)
 1434:             {
 1435:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1436:                 return;
 1437:             }
 1438:         }
 1439: 
 1440:         for(j = nombre_colonnes - 1; j >= 0; j--)
 1441:         {
 1442:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1443:                     &s_objet) == d_erreur)
 1444:             {
 1445:                 return;
 1446:             }
 1447: 
 1448:             if ((*s_objet).type == MIN)
 1449:             {
 1450:                 for(i = 0; i < nombre_lignes; i++)
 1451:                 {
 1452:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
 1453:                             .objet)).tableau)[i][j] = ((integer8 **)
 1454:                             (*((struct_matrice *) (*s_objet).objet))
 1455:                             .tableau)[i][0];
 1456:                 }
 1457:             }
 1458:             else
 1459:             {
 1460:                 for(i = 0; i < nombre_lignes; i++)
 1461:                 {
 1462:                     ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
 1463:                             .objet)).tableau)[i][j] = ((real8 **)
 1464:                             (*((struct_matrice *) (*s_objet).objet))
 1465:                             .tableau)[i][0];
 1466:                 }
 1467:             }
 1468: 
 1469:             liberation(s_etat_processus, s_objet);
 1470:         }
 1471:     }
 1472:     else
 1473:     {
 1474:         if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
 1475:         {
 1476:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1477:             return;
 1478:         }
 1479: 
 1480:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
 1481:                 nombre_colonnes;
 1482:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
 1483:                 nombre_lignes;
 1484: 
 1485:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
 1486:                 malloc(nombre_lignes * sizeof(complex16 *))) == NULL)
 1487:         {
 1488:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1489:             return;
 1490:         }
 1491: 
 1492:         for(i = 0; i < nombre_lignes; i++)
 1493:         {
 1494:             if ((((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1495:                     .objet)).tableau)[i] = malloc(nombre_colonnes *
 1496:                     sizeof(complex16))) == NULL)
 1497:             {
 1498:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1499:                 return;
 1500:             }
 1501:         }
 1502: 
 1503:         for(j = nombre_colonnes - 1; j >= 0; j--)
 1504:         {
 1505:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1506:                     &s_objet) == d_erreur)
 1507:             {
 1508:                 return;
 1509:             }
 1510: 
 1511:             if ((*s_objet).type == MIN)
 1512:             {
 1513:                 for(i = 0; i < nombre_lignes; i++)
 1514:                 {
 1515:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1516:                             .objet)).tableau)[i][j]).partie_reelle =
 1517:                             ((integer8 **) (*((struct_matrice *)
 1518:                             (*s_objet).objet)).tableau)[i][0];
 1519:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1520:                             .objet)).tableau)[i][j]).partie_imaginaire = 0;
 1521:                 }
 1522:             }
 1523:             else if ((*s_objet).type == MRL)
 1524:             {
 1525:                 for(i = 0; i < nombre_lignes; i++)
 1526:                 {
 1527:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1528:                             .objet)).tableau)[i][j]).partie_reelle =
 1529:                             ((real8 **) (*((struct_matrice *)
 1530:                             (*s_objet).objet)).tableau)[i][0];
 1531:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1532:                             .objet)).tableau)[i][j]).partie_imaginaire = 0;
 1533:                 }
 1534:             }
 1535:             else
 1536:             {
 1537:                 for(i = 0; i < nombre_lignes; i++)
 1538:                 {
 1539:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1540:                             .objet)).tableau)[i][j]).partie_reelle =
 1541:                             (((complex16 **) (*((struct_matrice *)
 1542:                             (*s_objet).objet)).tableau)[i][0]).partie_reelle;
 1543:                     (((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
 1544:                             .objet)).tableau)[i][j]).partie_imaginaire =
 1545:                             (((complex16 **) (*((struct_matrice *)
 1546:                             (*s_objet).objet)).tableau)[i][0])
 1547:                             .partie_imaginaire;
 1548:                 }
 1549:             }
 1550: 
 1551:             liberation(s_etat_processus, s_objet);
 1552:         }
 1553:     }
 1554: 
 1555:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1556:             s_objet_resultat) == d_erreur)
 1557:     {
 1558:         return;
 1559:     }
 1560: 
 1561:     return;
 1562: }
 1563: 
 1564: 
 1565: /*
 1566: ================================================================================
 1567:   Fonction '->NUM'
 1568: ================================================================================
 1569:   Entrées : structure processus
 1570: --------------------------------------------------------------------------------
 1571:   Sorties :
 1572: --------------------------------------------------------------------------------
 1573:   Effets de bord : néant
 1574: ================================================================================
 1575: */
 1576: 
 1577: void
 1578: instruction_fleche_num(struct_processus *s_etat_processus)
 1579: {
 1580:     logical1                        last_valide;
 1581: 
 1582:     struct_objet                    *s_objet;
 1583:     struct_objet                    *s_objet_simplifie;
 1584: 
 1585:     unsigned char                   registre_type_evaluation;
 1586: 
 1587:     (*s_etat_processus).erreur_execution = d_ex;
 1588: 
 1589:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1590:     {
 1591:         printf("\n  ->NUM ");
 1592: 
 1593:         if ((*s_etat_processus).langue == 'F')
 1594:         {
 1595:             printf("(évaluation d'un objet)\n\n");
 1596:         }
 1597:         else
 1598:         {
 1599:             printf("(object evaluation)\n\n");
 1600:         }
 1601: 
 1602:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
 1603:                 "       %s, %s, %s, %s, %s,\n"
 1604:                 "       %s, %s, %s, %s, %s,\n"
 1605:                 "       %s\n",
 1606:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 1607:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
 1608:         printf("->  n: %s, %s, %s, %s, %s, %s,\n"
 1609:                 "       %s, %s, %s, %s, %s,\n"
 1610:                 "       %s, %s, %s, %s, %s,\n"
 1611:                 "       %s\n",
 1612:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 1613:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
 1614:         printf("    ...\n");
 1615:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
 1616:                 "       %s, %s, %s, %s, %s,\n"
 1617:                 "       %s, %s, %s, %s, %s,\n"
 1618:                 "       %s\n",
 1619:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 1620:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
 1621: 
 1622:         return;
 1623:     }
 1624:     else if ((*s_etat_processus).test_instruction == 'Y')
 1625:     {
 1626:         (*s_etat_processus).nombre_arguments = -1;
 1627:         return;
 1628:     }
 1629: 
 1630:     if ((last_valide = test_cfsf(s_etat_processus, 31)) == d_vrai)
 1631:     {
 1632:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1633:         {
 1634:             return;
 1635:         }
 1636: 
 1637:         cf(s_etat_processus, 31);
 1638:     }
 1639: 
 1640:     registre_type_evaluation = (test_cfsf(s_etat_processus, 35) == d_vrai)
 1641:             ? 'E' : 'N';
 1642:     cf(s_etat_processus, 35);
 1643: 
 1644:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1645:             &s_objet) == d_erreur)
 1646:     {
 1647:         if (last_valide == d_vrai)
 1648:         {
 1649:             sf(s_etat_processus, 31);
 1650:         }
 1651: 
 1652:         if (registre_type_evaluation == 'E')
 1653:         {
 1654:             sf(s_etat_processus, 35);
 1655:         }
 1656:         else
 1657:         {
 1658:             cf(s_etat_processus, 35);
 1659:         }
 1660: 
 1661:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1662:         return;
 1663:     }
 1664: 
 1665:     if ((s_objet_simplifie = simplification(s_etat_processus, s_objet)) == NULL)
 1666:     {
 1667:         if (last_valide == d_vrai)
 1668:         {
 1669:             sf(s_etat_processus, 31);
 1670:         }
 1671: 
 1672:         if (registre_type_evaluation == 'E')
 1673:         {
 1674:             sf(s_etat_processus, 35);
 1675:         }
 1676:         else
 1677:         {
 1678:             cf(s_etat_processus, 35);
 1679:         }
 1680: 
 1681:         return;
 1682:     }
 1683: 
 1684:     liberation(s_etat_processus, s_objet);
 1685:     s_objet = s_objet_simplifie;
 1686: 
 1687:     if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur)
 1688:     {
 1689:         if (last_valide == d_vrai)
 1690:         {
 1691:             sf(s_etat_processus, 31);
 1692:         }
 1693: 
 1694:         if (registre_type_evaluation == 'E')
 1695:         {
 1696:             sf(s_etat_processus, 35);
 1697:         }
 1698:         else
 1699:         {
 1700:             cf(s_etat_processus, 35);
 1701:         }
 1702: 
 1703:         liberation(s_etat_processus, s_objet);
 1704:         return;
 1705:     }
 1706: 
 1707:     liberation(s_etat_processus, s_objet);
 1708: 
 1709:     if (registre_type_evaluation == 'E')
 1710:     {
 1711:         sf(s_etat_processus, 35);
 1712:     }
 1713:     else
 1714:     {
 1715:         cf(s_etat_processus, 35);
 1716:     }
 1717: 
 1718:     if (last_valide == d_vrai)
 1719:     {
 1720:         sf(s_etat_processus, 31);
 1721:     }
 1722: 
 1723:     return;
 1724: }
 1725: 
 1726: 
 1727: /*
 1728: ================================================================================
 1729:   Fonction 'fuse'
 1730: ================================================================================
 1731:   Entrées :
 1732: --------------------------------------------------------------------------------
 1733:   Sorties :
 1734: --------------------------------------------------------------------------------
 1735:   Effets de bord : néant
 1736: ================================================================================
 1737: */
 1738: 
 1739: void
 1740: instruction_fuse(struct_processus *s_etat_processus)
 1741: {
 1742:     pthread_attr_t          attributs;
 1743: 
 1744:     real8                   timeout;
 1745: 
 1746:     struct_objet            *s_objet_argument;
 1747: 
 1748:     (*s_etat_processus).erreur_execution = d_ex;
 1749: 
 1750:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1751:     {
 1752:         printf("\n  FUSE ");
 1753: 
 1754:         if ((*s_etat_processus).langue == 'F')
 1755:         {
 1756:             printf("(mise en place d'un fusible)\n\n");
 1757:         }
 1758:         else
 1759:         {
 1760:             printf("(set fuse signal)\n\n");
 1761:         }
 1762: 
 1763:         printf("    1: %s, %s\n", d_INT, d_REL);
 1764:         return;
 1765:     }
 1766:     else if ((*s_etat_processus).test_instruction == 'Y')
 1767:     {
 1768:         (*s_etat_processus).nombre_arguments = -1;
 1769:         return;
 1770:     }
 1771:     
 1772:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1773:     {
 1774:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1775:         {
 1776:             return;
 1777:         }
 1778:     }
 1779: 
 1780:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1781:                 &s_objet_argument) == d_erreur)
 1782:     {
 1783:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1784:         return;
 1785:     }
 1786: 
 1787:     if ((*s_etat_processus).presence_fusible == d_vrai)
 1788:     {
 1789:         liberation(s_etat_processus, s_objet_argument);
 1790: 
 1791:         (*s_etat_processus).erreur_execution = d_ex_fusible;
 1792:         return;
 1793:     }
 1794: 
 1795:     if ((*s_objet_argument).type == INT)
 1796:     {
 1797:         timeout = (real8) (*((integer8 *) (*s_objet_argument).objet));
 1798:     }
 1799:     else if ((*s_objet_argument).type == REL)
 1800:     {
 1801:         timeout = (*((real8 *) (*s_objet_argument).objet));
 1802:     }
 1803:     else
 1804:     {
 1805:         liberation(s_etat_processus, s_objet_argument);
 1806: 
 1807:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1808:         return;
 1809:     }
 1810: 
 1811:     liberation(s_etat_processus, s_objet_argument);
 1812: 
 1813:     if (timeout < 0)
 1814:     {
 1815:         (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1816:         return;
 1817:     }
 1818: 
 1819:     (*s_etat_processus).temps_maximal_cpu = timeout;
 1820:     (*s_etat_processus).presence_fusible = d_vrai;
 1821:     (*s_etat_processus).thread_surveille_par_fusible = pthread_self();
 1822: 
 1823:     // Génération du thread de surveillance
 1824: 
 1825:     if (pthread_attr_init(&attributs) != 0)
 1826:     {
 1827:         (*s_etat_processus).erreur_systeme = d_es_processus;
 1828:         return;
 1829:     }
 1830: 
 1831:     if (pthread_attr_setdetachstate(&attributs,
 1832:             PTHREAD_CREATE_DETACHED) != 0)
 1833:     {
 1834:         (*s_etat_processus).erreur_systeme = d_es_processus;
 1835:         return;
 1836:     }
 1837: 
 1838: #   ifdef SCHED_OTHER
 1839:     if (pthread_attr_setschedpolicy(&attributs, SCHED_OTHER) != 0)
 1840:     {
 1841:         (*s_etat_processus).erreur_systeme = d_es_processus;
 1842:         return;
 1843:     }
 1844: #   endif
 1845: 
 1846: #   ifdef PTHREAD_EXPLICIT_SCHED
 1847:     if (pthread_attr_setinheritsched(&attributs,
 1848:             PTHREAD_EXPLICIT_SCHED) != 0)
 1849:     {
 1850:         (*s_etat_processus).erreur_systeme = d_es_processus;
 1851:         return;
 1852:     }
 1853: #   endif
 1854: 
 1855: #   ifdef PTHREAD_SCOPE_SYSTEM
 1856:     if (pthread_attr_setscope(&attributs, PTHREAD_SCOPE_SYSTEM) != 0)
 1857:     {
 1858:         (*s_etat_processus).erreur_systeme = d_es_processus;
 1859:         return;
 1860:     }
 1861: #   endif
 1862: 
 1863:     if (pthread_create(&(*s_etat_processus).thread_fusible, &attributs, 
 1864:             fusible, s_etat_processus) != 0)
 1865:     {
 1866:         (*s_etat_processus).erreur_systeme = d_es_processus;
 1867:         return;
 1868:     }
 1869: 
 1870:     if (pthread_attr_destroy(&attributs) != 0)
 1871:     {
 1872:         (*s_etat_processus).erreur_systeme = d_es_processus;
 1873:         return;
 1874:     }
 1875: 
 1876:     return;
 1877: }
 1878: 
 1879: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>