File:  [local] / rpl / src / instructions_e1.c
Revision 1.46: download - view: text, annotated - select for diffs - revision graph
Fri Sep 6 10:30:53 2013 UTC (10 years, 7 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_16, HEAD
En route pour la 4.1.16.

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

CVSweb interface <joel.bertrand@systella.fr>