File:  [local] / rpl / src / instructions_e2.c
Revision 1.39: download - view: text, annotated - select for diffs - revision graph
Sat Sep 29 17:53:02 2012 UTC (11 years, 7 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_10, HEAD
Première série de patches pour l'ajout de FORALL. Reste à vérifier
les reprises sur erreurs ainsi que le bon déroulement de CYCLE, EXIT et RETURN.

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

CVSweb interface <joel.bertrand@systella.fr>