File:  [local] / rpl / src / instructions_e1.c
Revision 1.51: download - view: text, annotated - select for diffs - revision graph
Mon Oct 13 07:12:54 2014 UTC (9 years, 6 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Refonte des routines de simplification (non testées et marquées en
expérimental).

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

CVSweb interface <joel.bertrand@systella.fr>