File:  [local] / rpl / src / instructions_e1.c
Revision 1.68: download - view: text, annotated - select for diffs - revision graph
Sun Feb 3 14:40:38 2019 UTC (5 years, 2 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_31, HEAD
En route pour la 4.1.31.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.31
    4:   Copyright (C) 1989-2019 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,
  548:                         (*s_etat_processus).instruction_courante)) == NULL)
  549:                 {
  550:                     free((*s_etat_processus).instruction_courante);
  551:                     (*s_etat_processus).instruction_courante = tampon;
  552:                     (*s_etat_processus).erreur_systeme =
  553:                             d_es_allocation_memoire;
  554:                     return;
  555:                 }
  556: 
  557:                 if (niveau == 0)
  558:                 {
  559:                     if (strcmp(instruction_majuscule, "END") == 0)
  560:                     {
  561:                         (*s_etat_processus).position_courante -=
  562:                                 (((integer8) strlen(
  563:                                 instruction_majuscule)) + 1);
  564:                         drapeau_fin = d_vrai;
  565:                     }
  566:                     else
  567:                     {
  568:                         drapeau_fin = d_faux;
  569:                     }
  570:                 }
  571:                 else
  572:                 {
  573:                     drapeau_fin = d_faux;
  574:                 }
  575: 
  576:                 if ((strcmp(instruction_majuscule, "CASE") == 0) ||
  577:                         (strcmp(instruction_majuscule, "DO") == 0) ||
  578:                         (strcmp(instruction_majuscule, "IF") == 0) ||
  579:                         (strcmp(instruction_majuscule, "IFERR") == 0) ||
  580:                         (strcmp(instruction_majuscule, "SELECT") == 0) ||
  581:                         (strcmp(instruction_majuscule, "WHILE") == 0))
  582:                 {
  583:                     niveau++;
  584:                 }
  585:                 else if (strcmp(instruction_majuscule, "END") == 0)
  586:                 {
  587:                     niveau--;
  588:                 }
  589: 
  590:                 free(instruction_majuscule);
  591:                 free((*s_etat_processus).instruction_courante);
  592:             } while(drapeau_fin == d_faux);
  593: 
  594:             (*s_etat_processus).instruction_courante = tampon;
  595:         }
  596:         else
  597:         {
  598:             /*
  599:              * Vérification du pointeur de prédiction de saut.
  600:              */
  601: 
  602:             if (pthread_mutex_lock(&((*(*(*s_etat_processus)
  603:                     .expression_courante).donnee).mutex)) != 0)
  604:             {
  605:                 (*s_etat_processus).erreur_systeme = d_es_processus;
  606:                 return;
  607:             }
  608: 
  609:             if ((*((struct_fonction *) (*(*(*s_etat_processus)
  610:                     .expression_courante).donnee).objet)).prediction_saut
  611:                     != NULL)
  612:             {
  613:                 s_registre = (*s_etat_processus).expression_courante;
  614: 
  615:                 (*s_etat_processus).expression_courante =
  616:                         (struct_liste_chainee *)
  617:                         (*((struct_fonction *) (*(*(*s_etat_processus)
  618:                         .expression_courante).donnee).objet))
  619:                         .prediction_saut;
  620:                 fonction = (*((struct_fonction *)
  621:                         (*(*(*s_etat_processus).expression_courante)
  622:                         .donnee).objet)).fonction;
  623:                 execution = (*((struct_fonction *)
  624:                         (*(*s_registre).donnee).objet)).prediction_execution;
  625: 
  626:                 if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex)) != 0)
  627:                 {
  628:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  629:                     return;
  630:                 }
  631: 
  632:                 if (execution == d_vrai)
  633:                 {
  634:                     fonction(s_etat_processus);
  635:                 }
  636:             }
  637:             else
  638:             {
  639:                 if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
  640:                         .expression_courante).donnee).mutex)) != 0)
  641:                 {
  642:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  643:                     return;
  644:                 }
  645: 
  646:                 s_registre = (*s_etat_processus).expression_courante;
  647:                 execution = d_faux;
  648: 
  649:                 do
  650:                 {
  651:                     if (((*s_etat_processus).expression_courante =
  652:                             (*(*s_etat_processus).expression_courante).suivant)
  653:                             == NULL)
  654:                     {
  655:                         (*s_etat_processus).erreur_execution =
  656:                                 d_ex_erreur_traitement_condition;
  657:                         return;
  658:                     }
  659: 
  660:                     if ((*(*(*s_etat_processus).expression_courante)
  661:                             .donnee).type == FCT)
  662:                     {
  663:                         fonction = (*((struct_fonction *)
  664:                                 (*(*(*s_etat_processus).expression_courante)
  665:                                 .donnee).objet)).fonction;
  666: 
  667:                         if (niveau == 0)
  668:                         {
  669:                             if (fonction == instruction_end)
  670:                             {
  671:                                 fonction(s_etat_processus);
  672:                                 execution = d_vrai;
  673:                                 drapeau_fin = d_vrai;
  674:                             }
  675:                             else
  676:                             {
  677:                                 drapeau_fin = d_faux;
  678:                             }
  679:                         }
  680:                         else
  681:                         {
  682:                             drapeau_fin = d_faux;
  683:                         }
  684: 
  685:                         if ((fonction == instruction_case) ||
  686:                                 (fonction == instruction_do) ||
  687:                                 (fonction == instruction_if) ||
  688:                                 (fonction == instruction_iferr) ||
  689:                                 (fonction == instruction_select) ||
  690:                                 (fonction == instruction_while))
  691:                         {
  692:                             niveau++;
  693:                         }
  694:                         else if (fonction == instruction_end)
  695:                         {
  696:                             niveau--;
  697:                         }
  698:                     }
  699:                 } while(drapeau_fin == d_faux);
  700: 
  701:                 if (pthread_mutex_lock(&((*(*(*s_etat_processus)
  702:                         .expression_courante).donnee).mutex)) != 0)
  703:                 {
  704:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  705:                     return;
  706:                 }
  707: 
  708:                 (*((struct_fonction *) (*(*s_registre).donnee).objet))
  709:                         .prediction_saut = (*s_etat_processus)
  710:                         .expression_courante;
  711:                 (*((struct_fonction *) (*(*s_registre).donnee).objet))
  712:                         .prediction_execution = execution;
  713: 
  714:                 if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
  715:                         .expression_courante).donnee).mutex)) != 0)
  716:                 {
  717:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  718:                     return;
  719:                 }
  720:             }
  721:         }
  722:     }
  723:     else if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'E')
  724:     {
  725:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
  726:         return;
  727:     }
  728:     else
  729:     {
  730:         (*(*s_etat_processus).l_base_pile_systeme).clause = 'Z';
  731:     }
  732: 
  733:     return;
  734: }
  735: 
  736: 
  737: /*
  738: ================================================================================
  739:   Fonction 'elseif'
  740: ================================================================================
  741:   Entrées : structure processus
  742: --------------------------------------------------------------------------------
  743:   Sorties :
  744: --------------------------------------------------------------------------------
  745:   Effets de bord : néant
  746: ================================================================================
  747: */
  748: 
  749: void
  750: instruction_elseif(struct_processus *s_etat_processus)
  751: {
  752:     logical1                    drapeau_fin;
  753:     logical1                    execution;
  754: 
  755:     struct_liste_chainee        *s_registre;
  756: 
  757:     unsigned char               *instruction_majuscule;
  758:     unsigned char               *tampon;
  759: 
  760:     integer8                    niveau;
  761: 
  762:     void                        (*fonction)();
  763: 
  764:     (*s_etat_processus).erreur_execution = d_ex;
  765: 
  766:     if ((*s_etat_processus).affichage_arguments == 'Y')
  767:     {
  768:         printf("\n  ELSEIF ");
  769: 
  770:         if ((*s_etat_processus).langue == 'F')
  771:         {
  772:             printf("(structure de contrôle)\n\n");
  773:             printf("  Utilisation :\n\n");
  774:         }
  775:         else
  776:         {
  777:             printf("(control statement)\n\n");
  778:             printf("  Usage:\n\n");
  779:         }
  780: 
  781:         printf("    IF\n");
  782:         printf("        (expression test 1)\n");
  783:         printf("    THEN\n");
  784:         printf("        (expression 1)\n");
  785:         printf("    ELSEIF\n");
  786:         printf("        (expression test 2)\n");
  787:         printf("    THEN\n");
  788:         printf("        (expression 2)\n");
  789:         printf("    ...\n");
  790:         printf("    [ELSE\n");
  791:         printf("        (expression n)]\n");
  792:         printf("    END\n\n");
  793: 
  794:         return;
  795:     }
  796:     else if ((*s_etat_processus).test_instruction == 'Y')
  797:     {
  798:         (*s_etat_processus).nombre_arguments = -1;
  799:         return;
  800:     }
  801: 
  802:     if ((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'I')
  803:     {
  804:         (*s_etat_processus).erreur_execution =
  805:                 d_ex_erreur_traitement_condition;
  806:         return;
  807:     }
  808:         
  809:     if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'T')
  810:     {
  811:         /*
  812:          * On saute au END car le test précédent était vrai.
  813:          */
  814: 
  815:         niveau = 0;
  816:         drapeau_fin = d_faux;
  817: 
  818:         if ((*s_etat_processus).mode_execution_programme == 'Y')
  819:         {
  820:             tampon = (*s_etat_processus).instruction_courante;
  821: 
  822:             do
  823:             {
  824:                 if (recherche_instruction_suivante(s_etat_processus)
  825:                         == d_erreur)
  826:                 {
  827:                     if ((*s_etat_processus).instruction_courante != NULL)
  828:                     {
  829:                         free((*s_etat_processus).instruction_courante);
  830:                     }
  831: 
  832:                     (*s_etat_processus).instruction_courante = tampon;
  833:                     (*s_etat_processus).erreur_execution =
  834:                             d_ex_erreur_traitement_condition;
  835:                     return;
  836:                 }
  837: 
  838:                 if ((instruction_majuscule = conversion_majuscule(
  839:                         s_etat_processus,
  840:                         (*s_etat_processus).instruction_courante)) == NULL)
  841:                 {
  842:                     free((*s_etat_processus).instruction_courante);
  843:                     (*s_etat_processus).instruction_courante = tampon;
  844:                     (*s_etat_processus).erreur_systeme =
  845:                             d_es_allocation_memoire;
  846:                     return;
  847:                 }
  848: 
  849:                 if (niveau == 0)
  850:                 {
  851:                     if (strcmp(instruction_majuscule, "END") == 0)
  852:                     {
  853:                         (*s_etat_processus).position_courante -=
  854:                                 (((integer8) strlen(
  855:                                 instruction_majuscule)) + 1);
  856:                         drapeau_fin = d_vrai;
  857:                     }
  858:                     else
  859:                     {
  860:                         drapeau_fin = d_faux;
  861:                     }
  862:                 }
  863:                 else
  864:                 {
  865:                     drapeau_fin = d_faux;
  866:                 }
  867: 
  868:                 if ((strcmp(instruction_majuscule, "CASE") == 0) ||
  869:                         (strcmp(instruction_majuscule, "DO") == 0) ||
  870:                         (strcmp(instruction_majuscule, "IF") == 0) ||
  871:                         (strcmp(instruction_majuscule, "IFERR") == 0) ||
  872:                         (strcmp(instruction_majuscule, "SELECT") == 0) ||
  873:                         (strcmp(instruction_majuscule, "WHILE") == 0))
  874:                 {
  875:                     niveau++;
  876:                 }
  877:                 else if (strcmp(instruction_majuscule, "END") == 0)
  878:                 {
  879:                     niveau--;
  880:                 }
  881: 
  882:                 free(instruction_majuscule);
  883:                 free((*s_etat_processus).instruction_courante);
  884:             } while(drapeau_fin == d_faux);
  885: 
  886:             (*s_etat_processus).instruction_courante = tampon;
  887:         }
  888:         else
  889:         {
  890:             /*
  891:              * Vérification du pointeur de prédiction de saut
  892:              */
  893: 
  894:             if (pthread_mutex_lock(&((*(*(*s_etat_processus)
  895:                     .expression_courante).donnee).mutex)) != 0)
  896:             {
  897:                 (*s_etat_processus).erreur_systeme = d_es_processus;
  898:                 return;
  899:             }
  900: 
  901:             if ((*((struct_fonction *) (*(*(*s_etat_processus)
  902:                     .expression_courante).donnee).objet)).prediction_saut
  903:                     != NULL)
  904:             {
  905:                 s_registre = (*s_etat_processus).expression_courante;
  906: 
  907:                 (*s_etat_processus).expression_courante =
  908:                         (struct_liste_chainee *)
  909:                         (*((struct_fonction *) (*(*(*s_etat_processus)
  910:                         .expression_courante).donnee).objet))
  911:                         .prediction_saut;
  912:                 fonction = (*((struct_fonction *)
  913:                         (*(*(*s_etat_processus).expression_courante)
  914:                         .donnee).objet)).fonction;
  915:                 execution = (*((struct_fonction *)
  916:                         (*(*s_registre).donnee).objet)).prediction_execution;
  917: 
  918:                 if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex)) != 0)
  919:                 {
  920:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  921:                     return;
  922:                 }
  923: 
  924:                 if (execution == d_vrai)
  925:                 {
  926:                     fonction(s_etat_processus);
  927:                 }
  928:             }
  929:             else
  930:             {
  931:                 if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
  932:                         .expression_courante).donnee).mutex)) != 0)
  933:                 {
  934:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  935:                     return;
  936:                 }
  937: 
  938:                 s_registre = (*s_etat_processus).expression_courante;
  939:                 execution = d_faux;
  940: 
  941:                 do
  942:                 {
  943:                     if (((*s_etat_processus).expression_courante =
  944:                             (*(*s_etat_processus).expression_courante).suivant)
  945:                             == NULL)
  946:                     {
  947:                         (*s_etat_processus).erreur_execution =
  948:                                 d_ex_erreur_traitement_condition;
  949:                         return;
  950:                     }
  951: 
  952:                     if ((*(*(*s_etat_processus).expression_courante)
  953:                             .donnee).type == FCT)
  954:                     {
  955:                         fonction = (*((struct_fonction *)
  956:                                 (*(*(*s_etat_processus).expression_courante)
  957:                                 .donnee).objet)).fonction;
  958: 
  959:                         if (niveau == 0)
  960:                         {
  961:                             if (fonction == instruction_end)
  962:                             {
  963:                                 instruction_end(s_etat_processus);
  964:                                 execution = d_vrai;
  965:                                 drapeau_fin = d_vrai;
  966:                             }
  967:                             else
  968:                             {
  969:                                 drapeau_fin = d_faux;
  970:                             }
  971:                         }
  972:                         else
  973:                         {
  974:                             drapeau_fin = d_faux;
  975:                         }
  976: 
  977:                         if ((fonction == instruction_case) ||
  978:                                 (fonction == instruction_do) ||
  979:                                 (fonction == instruction_if) ||
  980:                                 (fonction == instruction_iferr) ||
  981:                                 (fonction == instruction_select) ||
  982:                                 (fonction == instruction_while))
  983:                         {
  984:                             niveau++;
  985:                         }
  986:                         else if (fonction == instruction_end)
  987:                         {
  988:                             niveau--;
  989:                         }
  990:                     }
  991:                 } while(drapeau_fin == d_faux);
  992: 
  993:                 if (pthread_mutex_lock(&((*(*(*s_etat_processus)
  994:                         .expression_courante).donnee).mutex)) != 0)
  995:                 {
  996:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  997:                     return;
  998:                 }
  999: 
 1000:                 (*((struct_fonction *) (*(*s_registre).donnee).objet))
 1001:                         .prediction_saut = (*s_etat_processus)
 1002:                         .expression_courante;
 1003:                 (*((struct_fonction *) (*(*s_registre).donnee).objet))
 1004:                         .prediction_execution = execution;
 1005: 
 1006:                 if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
 1007:                         .expression_courante).donnee).mutex)) != 0)
 1008:                 {
 1009:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 1010:                     return;
 1011:                 }
 1012:             }
 1013:         }
 1014:     }
 1015:     else
 1016:     {
 1017:         /*
 1018:          * On teste à nouveau...
 1019:          */
 1020: 
 1021:         (*(*s_etat_processus).l_base_pile_systeme).clause = 'I';
 1022:     }
 1023: 
 1024:     return;
 1025: }
 1026: 
 1027: 
 1028: /*
 1029: ================================================================================
 1030:   Fonction 'e'
 1031: ================================================================================
 1032:   Entrées : structure processus
 1033: --------------------------------------------------------------------------------
 1034:   Sorties :
 1035: --------------------------------------------------------------------------------
 1036:   Effets de bord : néant
 1037: ================================================================================
 1038: */
 1039: 
 1040: void
 1041: instruction_sensible_e(struct_processus *s_etat_processus)
 1042: {
 1043:     (*s_etat_processus).instruction_sensible = 'Y';
 1044: 
 1045:     if (strcmp((*s_etat_processus).instruction_courante, "e") == 0)
 1046:     {
 1047:         instruction_e(s_etat_processus);
 1048:     }
 1049:     else
 1050:     {
 1051:         (*s_etat_processus).instruction_valide = 'N';
 1052:     }
 1053: 
 1054:     return;
 1055: }
 1056: 
 1057: void
 1058: instruction_e(struct_processus *s_etat_processus)
 1059: {
 1060:     struct_objet                    *s_objet;
 1061: 
 1062:     (*s_etat_processus).erreur_execution = d_ex;
 1063: 
 1064:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1065:     {
 1066:         printf("\n  e ");
 1067:         
 1068:         if ((*s_etat_processus).langue == 'F')
 1069:         {
 1070:             printf("(base de logarithmes népériens)\n\n");
 1071:         }
 1072:         else
 1073:         {
 1074:             printf("(base of natural logarithm)\n\n");
 1075:         }
 1076: 
 1077:         printf("->  1: %s\n", d_REL);
 1078: 
 1079:         return;
 1080:     }
 1081:     else if ((*s_etat_processus).test_instruction == 'Y')
 1082:     {
 1083:         (*s_etat_processus).constante_symbolique = 'Y';
 1084:         (*s_etat_processus).nombre_arguments = -1;
 1085:         return;
 1086:     }
 1087: 
 1088:     /* Indicateur 35 armé => évaluation symbolique */
 1089:     if (test_cfsf(s_etat_processus, 35) == d_vrai)
 1090:     {
 1091:         if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
 1092:         {
 1093:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1094:             return;
 1095:         }
 1096: 
 1097:         if (((*((struct_nom *) (*s_objet).objet)).nom =
 1098:                 malloc(2 * sizeof(unsigned char))) == NULL)
 1099:         {
 1100:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1101:             return;
 1102:         }
 1103: 
 1104:         strcpy((*((struct_nom *) (*s_objet).objet)).nom, "e");
 1105:         (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
 1106:     }
 1107:     else
 1108:     {
 1109:         if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
 1110:         {
 1111:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1112:             return;
 1113:         }
 1114: 
 1115:         (*((real8 *) (*s_objet).objet)) = exp((real8) 1);
 1116:     }
 1117: 
 1118:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1119:             s_objet) == d_erreur)
 1120:     {
 1121:         return;
 1122:     }
 1123: 
 1124:     return;
 1125: }
 1126: 
 1127: 
 1128: /*
 1129: ================================================================================
 1130:   Fonction 'eng'
 1131: ================================================================================
 1132:   Entrées : pointeur sur une struct_processus
 1133: --------------------------------------------------------------------------------
 1134:   Sorties :
 1135: --------------------------------------------------------------------------------
 1136:   Effets de bord : néant
 1137: ================================================================================
 1138: */
 1139: 
 1140: void
 1141: instruction_eng(struct_processus *s_etat_processus)
 1142: {
 1143:     struct_objet                        *s_objet_argument;
 1144:     struct_objet                        *s_objet;
 1145: 
 1146:     logical1                            i43;
 1147:     logical1                            i44;
 1148: 
 1149:     unsigned char                       *valeur_binaire;
 1150: 
 1151:     unsigned long                       i;
 1152:     unsigned long                       j;
 1153: 
 1154:     (*s_etat_processus).erreur_execution = d_ex;
 1155: 
 1156:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1157:     {
 1158:         printf("\n  ENG ");
 1159: 
 1160:         if ((*s_etat_processus).langue == 'F')
 1161:         {
 1162:             printf("(notation ingénieur)\n\n");
 1163:             printf("  Aucun argument\n");
 1164:         }
 1165:         else
 1166:         {
 1167:             printf("(engineer notation)\n\n");
 1168:             printf("  No argument\n");
 1169:         }
 1170: 
 1171:         return;
 1172:     }
 1173:     else if ((*s_etat_processus).test_instruction == 'Y')
 1174:     {
 1175:         (*s_etat_processus).nombre_arguments = -1;
 1176:         return;
 1177:     }
 1178: 
 1179:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1180:     {
 1181:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1182:         {
 1183:             return;
 1184:         }
 1185:     }
 1186: 
 1187:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1188:             &s_objet_argument) == d_erreur)
 1189:     {
 1190:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1191:         return;
 1192:     }
 1193: 
 1194:     if ((*s_objet_argument).type == INT)
 1195:     {
 1196:         if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
 1197:                 ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
 1198:         {
 1199:             if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
 1200:             {
 1201:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1202:                 return;
 1203:             }
 1204: 
 1205:             (*((logical8 *) (*s_objet).objet)) = (logical8)
 1206:                     (*((integer8 *) (*s_objet_argument).objet));
 1207: 
 1208:             i43 = test_cfsf(s_etat_processus, 43);
 1209:             i44 = test_cfsf(s_etat_processus, 44);
 1210: 
 1211:             sf(s_etat_processus, 44);
 1212:             cf(s_etat_processus, 43);
 1213: 
 1214:             if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
 1215:                     == NULL)
 1216:             {
 1217:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1218:                 return;
 1219:             }
 1220: 
 1221:             if (i43 == d_vrai)
 1222:             {
 1223:                 sf(s_etat_processus, 43);
 1224:             }
 1225:             else
 1226:             {
 1227:                 cf(s_etat_processus, 43);
 1228:             }
 1229: 
 1230:             if (i44 == d_vrai)
 1231:             {
 1232:                 sf(s_etat_processus, 44);
 1233:             }
 1234:             else
 1235:             {
 1236:                 cf(s_etat_processus, 44);
 1237:             }
 1238: 
 1239:             for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
 1240:             {
 1241:                 if (valeur_binaire[i] == '0')
 1242:                 {
 1243:                     cf(s_etat_processus, (unsigned char) j++);
 1244:                 }
 1245:                 else
 1246:                 {
 1247:                     sf(s_etat_processus, (unsigned char) j++);
 1248:                 }
 1249:             }
 1250: 
 1251:             for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));
 1252: 
 1253:             sf(s_etat_processus, 49);
 1254:             sf(s_etat_processus, 50);
 1255: 
 1256:             free(valeur_binaire);
 1257:             liberation(s_etat_processus, s_objet);
 1258:         }
 1259:         else
 1260:         {
 1261:             liberation(s_etat_processus, s_objet_argument);
 1262: 
 1263:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1264:             return;
 1265:         }
 1266:     }
 1267:     else
 1268:     {
 1269:         liberation(s_etat_processus, s_objet_argument);
 1270: 
 1271:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1272:         return;
 1273:     }
 1274: 
 1275:     liberation(s_etat_processus, s_objet_argument);
 1276: 
 1277:     return;
 1278: }
 1279: 
 1280: 
 1281: /*
 1282: ================================================================================
 1283:   Fonction 'exp'
 1284: ================================================================================
 1285:   Entrées : pointeur sur une struct_processus
 1286: --------------------------------------------------------------------------------
 1287:   Sorties :
 1288: --------------------------------------------------------------------------------
 1289:   Effets de bord : néant
 1290: ================================================================================
 1291: */
 1292: 
 1293: void
 1294: instruction_exp(struct_processus *s_etat_processus)
 1295: {
 1296:     struct_liste_chainee            *l_element_courant;
 1297:     struct_liste_chainee            *l_element_precedent;
 1298: 
 1299:     struct_objet                    *s_copie_argument;
 1300:     struct_objet                    *s_objet_argument;
 1301:     struct_objet                    *s_objet_resultat;
 1302: 
 1303:     (*s_etat_processus).erreur_execution = d_ex;
 1304: 
 1305:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1306:     {
 1307:         printf("\n  EXP ");
 1308: 
 1309:         if ((*s_etat_processus).langue == 'F')
 1310:         {
 1311:             printf("(exponentielle)\n\n");
 1312:         }
 1313:         else
 1314:         {
 1315:             printf("(exponential)\n\n");
 1316:         }
 1317: 
 1318:         printf("    1: %s, %s\n", d_INT, d_REL);
 1319:         printf("->  1: %s\n\n", d_REL);
 1320: 
 1321:         printf("    1: %s\n", d_CPL);
 1322:         printf("->  1: %s\n\n", d_CPL);
 1323: 
 1324:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1325:         printf("->  1: %s\n\n", d_ALG);
 1326: 
 1327:         printf("    1: %s\n", d_RPN);
 1328:         printf("->  1: %s\n", d_RPN);
 1329: 
 1330:         return;
 1331:     }
 1332:     else if ((*s_etat_processus).test_instruction == 'Y')
 1333:     {
 1334:         (*s_etat_processus).nombre_arguments = 1;
 1335:         return;
 1336:     }
 1337: 
 1338:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1339:     {
 1340:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1341:         {
 1342:             return;
 1343:         }
 1344:     }
 1345: 
 1346:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1347:             &s_objet_argument) == d_erreur)
 1348:     {
 1349:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1350:         return;
 1351:     }
 1352: 
 1353: /*
 1354: --------------------------------------------------------------------------------
 1355:   Exponentielle d'un entier
 1356: --------------------------------------------------------------------------------
 1357: */
 1358: 
 1359:     if ((*s_objet_argument).type == INT)
 1360:     {
 1361:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1362:         {
 1363:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1364:             return;
 1365:         }
 1366: 
 1367:         (*((real8 *) (*s_objet_resultat).objet)) =
 1368:                 exp((real8) (*((integer8 *) (*s_objet_argument).objet)));
 1369:     }
 1370: 
 1371: /*
 1372: --------------------------------------------------------------------------------
 1373:   Exponentielle d'un réel
 1374: --------------------------------------------------------------------------------
 1375: */
 1376: 
 1377:     else if ((*s_objet_argument).type == REL)
 1378:     {
 1379:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1380:         {
 1381:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1382:             return;
 1383:         }
 1384: 
 1385:         (*((real8 *) (*s_objet_resultat).objet)) =
 1386:                 exp(((*((real8 *) (*s_objet_argument).objet))));
 1387:     }
 1388: 
 1389: /*
 1390: --------------------------------------------------------------------------------
 1391:   Exponentielle d'un complexe
 1392: --------------------------------------------------------------------------------
 1393: */
 1394: 
 1395:     else if ((*s_objet_argument).type == CPL)
 1396:     {
 1397:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
 1398:         {
 1399:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1400:             return;
 1401:         }
 1402: 
 1403:         f77expc_((struct_complexe16 *) (*s_objet_argument).objet,
 1404:                 (struct_complexe16 *) (*s_objet_resultat).objet);
 1405:     }
 1406: 
 1407: /*
 1408: --------------------------------------------------------------------------------
 1409:   Exponentielle d'un nom
 1410: --------------------------------------------------------------------------------
 1411: */
 1412: 
 1413:     else if ((*s_objet_argument).type == NOM)
 1414:     {
 1415:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 1416:         {
 1417:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1418:             return;
 1419:         }
 1420: 
 1421:         if (((*s_objet_resultat).objet =
 1422:                 allocation_maillon(s_etat_processus)) == NULL)
 1423:         {
 1424:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1425:             return;
 1426:         }
 1427: 
 1428:         l_element_courant = (*s_objet_resultat).objet;
 1429: 
 1430:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1431:                 == NULL)
 1432:         {
 1433:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1434:             return;
 1435:         }
 1436: 
 1437:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1438:                 .nombre_arguments = 0;
 1439:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1440:                 .fonction = instruction_vers_niveau_superieur;
 1441: 
 1442:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1443:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1444:         {
 1445:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1446:             return;
 1447:         }
 1448: 
 1449:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1450:                 .nom_fonction, "<<");
 1451: 
 1452:         if (((*l_element_courant).suivant =
 1453:                 allocation_maillon(s_etat_processus)) == NULL)
 1454:         {
 1455:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1456:             return;
 1457:         }
 1458: 
 1459:         l_element_courant = (*l_element_courant).suivant;
 1460:         (*l_element_courant).donnee = s_objet_argument;
 1461: 
 1462:         if (((*l_element_courant).suivant =
 1463:                 allocation_maillon(s_etat_processus)) == NULL)
 1464:         {
 1465:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1466:             return;
 1467:         }
 1468: 
 1469:         l_element_courant = (*l_element_courant).suivant;
 1470: 
 1471:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1472:                 == NULL)
 1473:         {
 1474:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1475:             return;
 1476:         }
 1477: 
 1478:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1479:                 .nombre_arguments = 1;
 1480:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1481:                 .fonction = instruction_exp;
 1482: 
 1483:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1484:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
 1485:         {
 1486:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1487:             return;
 1488:         }
 1489:             
 1490:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1491:                 .nom_fonction, "EXP");
 1492: 
 1493:         if (((*l_element_courant).suivant =
 1494:                 allocation_maillon(s_etat_processus)) == NULL)
 1495:         {
 1496:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1497:             return;
 1498:         }
 1499: 
 1500:         l_element_courant = (*l_element_courant).suivant;
 1501: 
 1502:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1503:                 == NULL)
 1504:         {
 1505:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1506:             return;
 1507:         }
 1508: 
 1509:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1510:                 .nombre_arguments = 0;
 1511:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1512:                 .fonction = instruction_vers_niveau_inferieur;
 1513: 
 1514:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1515:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1516:         {
 1517:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1518:             return;
 1519:         }
 1520: 
 1521:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1522:                 .nom_fonction, ">>");
 1523: 
 1524:         (*l_element_courant).suivant = NULL;
 1525:         s_objet_argument = NULL;
 1526:     }
 1527: 
 1528: /*
 1529: --------------------------------------------------------------------------------
 1530:   Exponentielle d'une expression
 1531: --------------------------------------------------------------------------------
 1532: */
 1533: 
 1534:     else if (((*s_objet_argument).type == ALG) ||
 1535:             ((*s_objet_argument).type == RPN))
 1536:     {
 1537:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1538:                 s_objet_argument, 'N')) == NULL)
 1539:         {
 1540:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1541:             return;
 1542:         }
 1543: 
 1544:         l_element_courant = (struct_liste_chainee *)
 1545:                 (*s_copie_argument).objet;
 1546:         l_element_precedent = l_element_courant;
 1547: 
 1548:         while((*l_element_courant).suivant != NULL)
 1549:         {
 1550:             l_element_precedent = l_element_courant;
 1551:             l_element_courant = (*l_element_courant).suivant;
 1552:         }
 1553: 
 1554:         if (((*l_element_precedent).suivant =
 1555:                 allocation_maillon(s_etat_processus)) == NULL)
 1556:         {
 1557:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1558:             return;
 1559:         }
 1560: 
 1561:         if (((*(*l_element_precedent).suivant).donnee =
 1562:                 allocation(s_etat_processus, FCT)) == NULL)
 1563:         {
 1564:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1565:             return;
 1566:         }
 1567: 
 1568:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1569:                 .donnee).objet)).nombre_arguments = 1;
 1570:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1571:                 .donnee).objet)).fonction = instruction_exp;
 1572: 
 1573:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1574:                 .suivant).donnee).objet)).nom_fonction =
 1575:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1576:         {
 1577:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1578:             return;
 1579:         }
 1580: 
 1581:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1582:                 .suivant).donnee).objet)).nom_fonction, "EXP");
 1583: 
 1584:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1585: 
 1586:         s_objet_resultat = s_copie_argument;
 1587:     }
 1588: 
 1589: /*
 1590: --------------------------------------------------------------------------------
 1591:   Fonction exponentielle impossible à réaliser
 1592: --------------------------------------------------------------------------------
 1593: */
 1594: 
 1595:     else
 1596:     {
 1597:         liberation(s_etat_processus, s_objet_argument);
 1598: 
 1599:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1600:         return;
 1601:     }
 1602: 
 1603:     liberation(s_etat_processus, s_objet_argument);
 1604: 
 1605:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1606:             s_objet_resultat) == d_erreur)
 1607:     {
 1608:         return;
 1609:     }
 1610: 
 1611:     return;
 1612: }
 1613: 
 1614: 
 1615: /*
 1616: ================================================================================
 1617:   Fonction 'exp' (-1)
 1618: ================================================================================
 1619:   Entrées : pointeur sur une struct_processus
 1620: --------------------------------------------------------------------------------
 1621:   Sorties :
 1622: --------------------------------------------------------------------------------
 1623:   Effets de bord : néant
 1624: ================================================================================
 1625: */
 1626: 
 1627: void
 1628: instruction_expm(struct_processus *s_etat_processus)
 1629: {
 1630:     struct_liste_chainee            *l_element_courant;
 1631:     struct_liste_chainee            *l_element_precedent;
 1632: 
 1633:     struct_objet                    *s_copie_argument;
 1634:     struct_objet                    *s_objet_argument;
 1635:     struct_objet                    *s_objet_resultat;
 1636: 
 1637:     (*s_etat_processus).erreur_execution = d_ex;
 1638: 
 1639:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1640:     {
 1641:         printf("\n  EXPM ");
 1642: 
 1643:         if ((*s_etat_processus).langue == 'F')
 1644:         {
 1645:             printf("(exponentielle moins un)\n\n");
 1646:         }
 1647:         else
 1648:         {
 1649:             printf("(exp - 1)\n\n");
 1650:         }
 1651: 
 1652:         printf("    1: %s, %s\n", d_INT, d_REL);
 1653:         printf("->  1: %s\n\n", d_REL);
 1654: 
 1655:         printf("    1: %s\n", d_CPL);
 1656:         printf("->  1: %s\n\n", d_CPL);
 1657: 
 1658:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1659:         printf("->  1: %s\n\n", d_ALG);
 1660: 
 1661:         printf("    1: %s\n", d_RPN);
 1662:         printf("->  1: %s\n", d_RPN);
 1663: 
 1664:         return;
 1665:     }
 1666:     else if ((*s_etat_processus).test_instruction == 'Y')
 1667:     {
 1668:         (*s_etat_processus).nombre_arguments = 1;
 1669:         return;
 1670:     }
 1671: 
 1672:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1673:     {
 1674:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1675:         {
 1676:             return;
 1677:         }
 1678:     }
 1679: 
 1680:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1681:             &s_objet_argument) == d_erreur)
 1682:     {
 1683:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1684:         return;
 1685:     }
 1686: 
 1687: /*
 1688: --------------------------------------------------------------------------------
 1689:   Exponentielle (-1) d'un entier
 1690: --------------------------------------------------------------------------------
 1691: */
 1692: 
 1693:     if ((*s_objet_argument).type == INT)
 1694:     {
 1695:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1696:         {
 1697:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1698:             return;
 1699:         }
 1700: 
 1701:         (*((real8 *) (*s_objet_resultat).objet)) =
 1702:                 expm1((real8) (*((integer8 *) (*s_objet_argument).objet)));
 1703:     }
 1704: 
 1705: /*
 1706: --------------------------------------------------------------------------------
 1707:   Exponentielle (-1) d'un réel
 1708: --------------------------------------------------------------------------------
 1709: */
 1710: 
 1711:     else if ((*s_objet_argument).type == REL)
 1712:     {
 1713:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1714:         {
 1715:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1716:             return;
 1717:         }
 1718: 
 1719:         (*((real8 *) (*s_objet_resultat).objet)) =
 1720:                 expm1(((*((real8 *) (*s_objet_argument).objet))));
 1721:     }
 1722: 
 1723: /*
 1724: --------------------------------------------------------------------------------
 1725:   Exponentielle (-1) d'un nom
 1726: --------------------------------------------------------------------------------
 1727: */
 1728: 
 1729:     else if ((*s_objet_argument).type == NOM)
 1730:     {
 1731:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 1732:         {
 1733:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1734:             return;
 1735:         }
 1736: 
 1737:         if (((*s_objet_resultat).objet =
 1738:                 allocation_maillon(s_etat_processus)) == NULL)
 1739:         {
 1740:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1741:             return;
 1742:         }
 1743: 
 1744:         l_element_courant = (*s_objet_resultat).objet;
 1745: 
 1746:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1747:                 == NULL)
 1748:         {
 1749:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1750:             return;
 1751:         }
 1752: 
 1753:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1754:                 .nombre_arguments = 0;
 1755:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1756:                 .fonction = instruction_vers_niveau_superieur;
 1757: 
 1758:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1759:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1760:         {
 1761:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1762:             return;
 1763:         }
 1764: 
 1765:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1766:                 .nom_fonction, "<<");
 1767: 
 1768:         if (((*l_element_courant).suivant =
 1769:                 allocation_maillon(s_etat_processus)) == NULL)
 1770:         {
 1771:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1772:             return;
 1773:         }
 1774: 
 1775:         l_element_courant = (*l_element_courant).suivant;
 1776:         (*l_element_courant).donnee = s_objet_argument;
 1777: 
 1778:         if (((*l_element_courant).suivant =
 1779:                 allocation_maillon(s_etat_processus)) == NULL)
 1780:         {
 1781:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1782:             return;
 1783:         }
 1784: 
 1785:         l_element_courant = (*l_element_courant).suivant;
 1786: 
 1787:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1788:                 == NULL)
 1789:         {
 1790:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1791:             return;
 1792:         }
 1793: 
 1794:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1795:                 .nombre_arguments = 1;
 1796:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1797:                 .fonction = instruction_expm;
 1798: 
 1799:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1800:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 1801:         {
 1802:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1803:             return;
 1804:         }
 1805:             
 1806:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1807:                 .nom_fonction, "EXPM");
 1808: 
 1809:         if (((*l_element_courant).suivant =
 1810:                 allocation_maillon(s_etat_processus)) == NULL)
 1811:         {
 1812:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1813:             return;
 1814:         }
 1815: 
 1816:         l_element_courant = (*l_element_courant).suivant;
 1817: 
 1818:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1819:                 == NULL)
 1820:         {
 1821:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1822:             return;
 1823:         }
 1824: 
 1825:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1826:                 .nombre_arguments = 0;
 1827:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1828:                 .fonction = instruction_vers_niveau_inferieur;
 1829: 
 1830:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1831:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1832:         {
 1833:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1834:             return;
 1835:         }
 1836: 
 1837:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1838:                 .nom_fonction, ">>");
 1839: 
 1840:         (*l_element_courant).suivant = NULL;
 1841:         s_objet_argument = NULL;
 1842:     }
 1843: 
 1844: /*
 1845: --------------------------------------------------------------------------------
 1846:   Exponentielle (-1) d'une expression
 1847: --------------------------------------------------------------------------------
 1848: */
 1849: 
 1850:     else if (((*s_objet_argument).type == ALG) ||
 1851:             ((*s_objet_argument).type == RPN))
 1852:     {
 1853:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1854:                 s_objet_argument, 'N')) == NULL)
 1855:         {
 1856:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1857:             return;
 1858:         }
 1859: 
 1860:         l_element_courant = (struct_liste_chainee *)
 1861:                 (*s_copie_argument).objet;
 1862:         l_element_precedent = l_element_courant;
 1863: 
 1864:         while((*l_element_courant).suivant != NULL)
 1865:         {
 1866:             l_element_precedent = l_element_courant;
 1867:             l_element_courant = (*l_element_courant).suivant;
 1868:         }
 1869: 
 1870:         if (((*l_element_precedent).suivant =
 1871:                 allocation_maillon(s_etat_processus)) == NULL)
 1872:         {
 1873:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1874:             return;
 1875:         }
 1876: 
 1877:         if (((*(*l_element_precedent).suivant).donnee =
 1878:                 allocation(s_etat_processus, FCT)) == NULL)
 1879:         {
 1880:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1881:             return;
 1882:         }
 1883: 
 1884:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1885:                 .donnee).objet)).nombre_arguments = 1;
 1886:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1887:                 .donnee).objet)).fonction = instruction_expm;
 1888: 
 1889:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1890:                 .suivant).donnee).objet)).nom_fonction =
 1891:                 malloc(5 * sizeof(unsigned char))) == NULL)
 1892:         {
 1893:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1894:             return;
 1895:         }
 1896: 
 1897:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1898:                 .suivant).donnee).objet)).nom_fonction, "EXPM");
 1899: 
 1900:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1901: 
 1902:         s_objet_resultat = s_copie_argument;
 1903:     }
 1904: 
 1905: /*
 1906: --------------------------------------------------------------------------------
 1907:   Fonction exponentielle (-1) impossible à réaliser
 1908: --------------------------------------------------------------------------------
 1909: */
 1910: 
 1911:     else
 1912:     {
 1913:         liberation(s_etat_processus, s_objet_argument);
 1914: 
 1915:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1916:         return;
 1917:     }
 1918: 
 1919:     liberation(s_etat_processus, s_objet_argument);
 1920: 
 1921:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1922:             s_objet_resultat) == d_erreur)
 1923:     {
 1924:         return;
 1925:     }
 1926: 
 1927:     return;
 1928: }
 1929: 
 1930: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>