File:  [local] / rpl / src / instructions_e1.c
Revision 1.55: download - view: text, annotated - select for diffs - revision graph
Thu Feb 19 11:01:23 2015 UTC (9 years, 2 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_21, HEAD
En route pour la 4.1.21.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.21
    4:   Copyright (C) 1989-2015 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:     if (strcmp((*s_etat_processus).instruction_courante, "e") == 0)
 1044:     {
 1045:         instruction_e(s_etat_processus);
 1046:     }
 1047:     else
 1048:     {
 1049:         (*s_etat_processus).instruction_valide = 'N';
 1050:     }
 1051: 
 1052:     return;
 1053: }
 1054: 
 1055: void
 1056: instruction_e(struct_processus *s_etat_processus)
 1057: {
 1058:     struct_objet                    *s_objet;
 1059: 
 1060:     (*s_etat_processus).erreur_execution = d_ex;
 1061: 
 1062:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1063:     {
 1064:         printf("\n  e ");
 1065:         
 1066:         if ((*s_etat_processus).langue == 'F')
 1067:         {
 1068:             printf("(base de logarithmes népériens)\n\n");
 1069:         }
 1070:         else
 1071:         {
 1072:             printf("(base of natural logarithm)\n\n");
 1073:         }
 1074: 
 1075:         printf("->  1: %s\n", d_REL);
 1076: 
 1077:         return;
 1078:     }
 1079:     else if ((*s_etat_processus).test_instruction == 'Y')
 1080:     {
 1081:         (*s_etat_processus).constante_symbolique = 'Y';
 1082:         (*s_etat_processus).nombre_arguments = -1;
 1083:         return;
 1084:     }
 1085: 
 1086:     /* Indicateur 35 armé => évaluation symbolique */
 1087:     if (test_cfsf(s_etat_processus, 35) == d_vrai)
 1088:     {
 1089:         if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
 1090:         {
 1091:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1092:             return;
 1093:         }
 1094: 
 1095:         if (((*((struct_nom *) (*s_objet).objet)).nom =
 1096:                 malloc(2 * sizeof(unsigned char))) == NULL)
 1097:         {
 1098:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1099:             return;
 1100:         }
 1101: 
 1102:         strcpy((*((struct_nom *) (*s_objet).objet)).nom, "e");
 1103:         (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
 1104:     }
 1105:     else
 1106:     {
 1107:         if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
 1108:         {
 1109:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1110:             return;
 1111:         }
 1112: 
 1113:         (*((real8 *) (*s_objet).objet)) = exp((real8) 1);
 1114:     }
 1115: 
 1116:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1117:             s_objet) == d_erreur)
 1118:     {
 1119:         return;
 1120:     }
 1121: 
 1122:     return;
 1123: }
 1124: 
 1125: 
 1126: /*
 1127: ================================================================================
 1128:   Fonction 'eng'
 1129: ================================================================================
 1130:   Entrées : pointeur sur une struct_processus
 1131: --------------------------------------------------------------------------------
 1132:   Sorties :
 1133: --------------------------------------------------------------------------------
 1134:   Effets de bord : néant
 1135: ================================================================================
 1136: */
 1137: 
 1138: void
 1139: instruction_eng(struct_processus *s_etat_processus)
 1140: {
 1141:     struct_objet                        *s_objet_argument;
 1142:     struct_objet                        *s_objet;
 1143: 
 1144:     logical1                            i43;
 1145:     logical1                            i44;
 1146: 
 1147:     unsigned char                       *valeur_binaire;
 1148: 
 1149:     unsigned long                       i;
 1150:     unsigned long                       j;
 1151: 
 1152:     (*s_etat_processus).erreur_execution = d_ex;
 1153: 
 1154:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1155:     {
 1156:         printf("\n  ENG ");
 1157: 
 1158:         if ((*s_etat_processus).langue == 'F')
 1159:         {
 1160:             printf("(notation ingénieur)\n\n");
 1161:             printf("  Aucun argument\n");
 1162:         }
 1163:         else
 1164:         {
 1165:             printf("(engineer notation)\n\n");
 1166:             printf("  No argument\n");
 1167:         }
 1168: 
 1169:         return;
 1170:     }
 1171:     else if ((*s_etat_processus).test_instruction == 'Y')
 1172:     {
 1173:         (*s_etat_processus).nombre_arguments = -1;
 1174:         return;
 1175:     }
 1176: 
 1177:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1178:     {
 1179:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1180:         {
 1181:             return;
 1182:         }
 1183:     }
 1184: 
 1185:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1186:             &s_objet_argument) == d_erreur)
 1187:     {
 1188:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1189:         return;
 1190:     }
 1191: 
 1192:     if ((*s_objet_argument).type == INT)
 1193:     {
 1194:         if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
 1195:                 ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
 1196:         {
 1197:             if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
 1198:             {
 1199:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1200:                 return;
 1201:             }
 1202: 
 1203:             (*((logical8 *) (*s_objet).objet)) = (logical8)
 1204:                     (*((integer8 *) (*s_objet_argument).objet));
 1205: 
 1206:             i43 = test_cfsf(s_etat_processus, 43);
 1207:             i44 = test_cfsf(s_etat_processus, 44);
 1208: 
 1209:             sf(s_etat_processus, 44);
 1210:             cf(s_etat_processus, 43);
 1211: 
 1212:             if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
 1213:                     == NULL)
 1214:             {
 1215:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1216:                 return;
 1217:             }
 1218: 
 1219:             if (i43 == d_vrai)
 1220:             {
 1221:                 sf(s_etat_processus, 43);
 1222:             }
 1223:             else
 1224:             {
 1225:                 cf(s_etat_processus, 43);
 1226:             }
 1227: 
 1228:             if (i44 == d_vrai)
 1229:             {
 1230:                 sf(s_etat_processus, 44);
 1231:             }
 1232:             else
 1233:             {
 1234:                 cf(s_etat_processus, 44);
 1235:             }
 1236: 
 1237:             for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
 1238:             {
 1239:                 if (valeur_binaire[i] == '0')
 1240:                 {
 1241:                     cf(s_etat_processus, (unsigned char) j++);
 1242:                 }
 1243:                 else
 1244:                 {
 1245:                     sf(s_etat_processus, (unsigned char) j++);
 1246:                 }
 1247:             }
 1248: 
 1249:             for(; j <= 56; cf(s_etat_processus, (unsigned char) j++));
 1250: 
 1251:             sf(s_etat_processus, 49);
 1252:             sf(s_etat_processus, 50);
 1253: 
 1254:             free(valeur_binaire);
 1255:             liberation(s_etat_processus, s_objet);
 1256:         }
 1257:         else
 1258:         {
 1259:             liberation(s_etat_processus, s_objet_argument);
 1260: 
 1261:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1262:             return;
 1263:         }
 1264:     }
 1265:     else
 1266:     {
 1267:         liberation(s_etat_processus, s_objet_argument);
 1268: 
 1269:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1270:         return;
 1271:     }
 1272: 
 1273:     liberation(s_etat_processus, s_objet_argument);
 1274: 
 1275:     return;
 1276: }
 1277: 
 1278: 
 1279: /*
 1280: ================================================================================
 1281:   Fonction 'exp'
 1282: ================================================================================
 1283:   Entrées : pointeur sur une struct_processus
 1284: --------------------------------------------------------------------------------
 1285:   Sorties :
 1286: --------------------------------------------------------------------------------
 1287:   Effets de bord : néant
 1288: ================================================================================
 1289: */
 1290: 
 1291: void
 1292: instruction_exp(struct_processus *s_etat_processus)
 1293: {
 1294:     struct_liste_chainee            *l_element_courant;
 1295:     struct_liste_chainee            *l_element_precedent;
 1296: 
 1297:     struct_objet                    *s_copie_argument;
 1298:     struct_objet                    *s_objet_argument;
 1299:     struct_objet                    *s_objet_resultat;
 1300: 
 1301:     (*s_etat_processus).erreur_execution = d_ex;
 1302: 
 1303:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1304:     {
 1305:         printf("\n  EXP ");
 1306: 
 1307:         if ((*s_etat_processus).langue == 'F')
 1308:         {
 1309:             printf("(exponentielle)\n\n");
 1310:         }
 1311:         else
 1312:         {
 1313:             printf("(exponential)\n\n");
 1314:         }
 1315: 
 1316:         printf("    1: %s, %s\n", d_INT, d_REL);
 1317:         printf("->  1: %s\n\n", d_REL);
 1318: 
 1319:         printf("    1: %s\n", d_CPL);
 1320:         printf("->  1: %s\n\n", d_CPL);
 1321: 
 1322:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1323:         printf("->  1: %s\n\n", d_ALG);
 1324: 
 1325:         printf("    1: %s\n", d_RPN);
 1326:         printf("->  1: %s\n", d_RPN);
 1327: 
 1328:         return;
 1329:     }
 1330:     else if ((*s_etat_processus).test_instruction == 'Y')
 1331:     {
 1332:         (*s_etat_processus).nombre_arguments = 1;
 1333:         return;
 1334:     }
 1335: 
 1336:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1337:     {
 1338:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1339:         {
 1340:             return;
 1341:         }
 1342:     }
 1343: 
 1344:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1345:             &s_objet_argument) == d_erreur)
 1346:     {
 1347:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1348:         return;
 1349:     }
 1350: 
 1351: /*
 1352: --------------------------------------------------------------------------------
 1353:   Exponentielle d'un entier
 1354: --------------------------------------------------------------------------------
 1355: */
 1356: 
 1357:     if ((*s_objet_argument).type == INT)
 1358:     {
 1359:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1360:         {
 1361:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1362:             return;
 1363:         }
 1364: 
 1365:         (*((real8 *) (*s_objet_resultat).objet)) =
 1366:                 exp((real8) (*((integer8 *) (*s_objet_argument).objet)));
 1367:     }
 1368: 
 1369: /*
 1370: --------------------------------------------------------------------------------
 1371:   Exponentielle d'un réel
 1372: --------------------------------------------------------------------------------
 1373: */
 1374: 
 1375:     else if ((*s_objet_argument).type == REL)
 1376:     {
 1377:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1378:         {
 1379:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1380:             return;
 1381:         }
 1382: 
 1383:         (*((real8 *) (*s_objet_resultat).objet)) =
 1384:                 exp(((*((real8 *) (*s_objet_argument).objet))));
 1385:     }
 1386: 
 1387: /*
 1388: --------------------------------------------------------------------------------
 1389:   Exponentielle d'un complexe
 1390: --------------------------------------------------------------------------------
 1391: */
 1392: 
 1393:     else if ((*s_objet_argument).type == CPL)
 1394:     {
 1395:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
 1396:         {
 1397:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1398:             return;
 1399:         }
 1400: 
 1401:         f77expc_((struct_complexe16 *) (*s_objet_argument).objet,
 1402:                 (struct_complexe16 *) (*s_objet_resultat).objet);
 1403:     }
 1404: 
 1405: /*
 1406: --------------------------------------------------------------------------------
 1407:   Exponentielle d'un nom
 1408: --------------------------------------------------------------------------------
 1409: */
 1410: 
 1411:     else if ((*s_objet_argument).type == NOM)
 1412:     {
 1413:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 1414:         {
 1415:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1416:             return;
 1417:         }
 1418: 
 1419:         if (((*s_objet_resultat).objet =
 1420:                 allocation_maillon(s_etat_processus)) == NULL)
 1421:         {
 1422:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1423:             return;
 1424:         }
 1425: 
 1426:         l_element_courant = (*s_objet_resultat).objet;
 1427: 
 1428:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1429:                 == NULL)
 1430:         {
 1431:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1432:             return;
 1433:         }
 1434: 
 1435:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1436:                 .nombre_arguments = 0;
 1437:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1438:                 .fonction = instruction_vers_niveau_superieur;
 1439: 
 1440:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1441:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1442:         {
 1443:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1444:             return;
 1445:         }
 1446: 
 1447:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1448:                 .nom_fonction, "<<");
 1449: 
 1450:         if (((*l_element_courant).suivant =
 1451:                 allocation_maillon(s_etat_processus)) == NULL)
 1452:         {
 1453:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1454:             return;
 1455:         }
 1456: 
 1457:         l_element_courant = (*l_element_courant).suivant;
 1458:         (*l_element_courant).donnee = s_objet_argument;
 1459: 
 1460:         if (((*l_element_courant).suivant =
 1461:                 allocation_maillon(s_etat_processus)) == NULL)
 1462:         {
 1463:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1464:             return;
 1465:         }
 1466: 
 1467:         l_element_courant = (*l_element_courant).suivant;
 1468: 
 1469:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1470:                 == NULL)
 1471:         {
 1472:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1473:             return;
 1474:         }
 1475: 
 1476:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1477:                 .nombre_arguments = 1;
 1478:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1479:                 .fonction = instruction_exp;
 1480: 
 1481:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1482:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
 1483:         {
 1484:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1485:             return;
 1486:         }
 1487:             
 1488:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1489:                 .nom_fonction, "EXP");
 1490: 
 1491:         if (((*l_element_courant).suivant =
 1492:                 allocation_maillon(s_etat_processus)) == NULL)
 1493:         {
 1494:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1495:             return;
 1496:         }
 1497: 
 1498:         l_element_courant = (*l_element_courant).suivant;
 1499: 
 1500:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1501:                 == NULL)
 1502:         {
 1503:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1504:             return;
 1505:         }
 1506: 
 1507:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1508:                 .nombre_arguments = 0;
 1509:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1510:                 .fonction = instruction_vers_niveau_inferieur;
 1511: 
 1512:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1513:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1514:         {
 1515:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1516:             return;
 1517:         }
 1518: 
 1519:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1520:                 .nom_fonction, ">>");
 1521: 
 1522:         (*l_element_courant).suivant = NULL;
 1523:         s_objet_argument = NULL;
 1524:     }
 1525: 
 1526: /*
 1527: --------------------------------------------------------------------------------
 1528:   Exponentielle d'une expression
 1529: --------------------------------------------------------------------------------
 1530: */
 1531: 
 1532:     else if (((*s_objet_argument).type == ALG) ||
 1533:             ((*s_objet_argument).type == RPN))
 1534:     {
 1535:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1536:                 s_objet_argument, 'N')) == NULL)
 1537:         {
 1538:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1539:             return;
 1540:         }
 1541: 
 1542:         l_element_courant = (struct_liste_chainee *)
 1543:                 (*s_copie_argument).objet;
 1544:         l_element_precedent = l_element_courant;
 1545: 
 1546:         while((*l_element_courant).suivant != NULL)
 1547:         {
 1548:             l_element_precedent = l_element_courant;
 1549:             l_element_courant = (*l_element_courant).suivant;
 1550:         }
 1551: 
 1552:         if (((*l_element_precedent).suivant =
 1553:                 allocation_maillon(s_etat_processus)) == NULL)
 1554:         {
 1555:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1556:             return;
 1557:         }
 1558: 
 1559:         if (((*(*l_element_precedent).suivant).donnee =
 1560:                 allocation(s_etat_processus, FCT)) == NULL)
 1561:         {
 1562:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1563:             return;
 1564:         }
 1565: 
 1566:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1567:                 .donnee).objet)).nombre_arguments = 1;
 1568:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1569:                 .donnee).objet)).fonction = instruction_exp;
 1570: 
 1571:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1572:                 .suivant).donnee).objet)).nom_fonction =
 1573:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1574:         {
 1575:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1576:             return;
 1577:         }
 1578: 
 1579:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1580:                 .suivant).donnee).objet)).nom_fonction, "EXP");
 1581: 
 1582:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1583: 
 1584:         s_objet_resultat = s_copie_argument;
 1585:     }
 1586: 
 1587: /*
 1588: --------------------------------------------------------------------------------
 1589:   Fonction exponentielle impossible à réaliser
 1590: --------------------------------------------------------------------------------
 1591: */
 1592: 
 1593:     else
 1594:     {
 1595:         liberation(s_etat_processus, s_objet_argument);
 1596: 
 1597:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1598:         return;
 1599:     }
 1600: 
 1601:     liberation(s_etat_processus, s_objet_argument);
 1602: 
 1603:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1604:             s_objet_resultat) == d_erreur)
 1605:     {
 1606:         return;
 1607:     }
 1608: 
 1609:     return;
 1610: }
 1611: 
 1612: 
 1613: /*
 1614: ================================================================================
 1615:   Fonction 'exp' (-1)
 1616: ================================================================================
 1617:   Entrées : pointeur sur une struct_processus
 1618: --------------------------------------------------------------------------------
 1619:   Sorties :
 1620: --------------------------------------------------------------------------------
 1621:   Effets de bord : néant
 1622: ================================================================================
 1623: */
 1624: 
 1625: void
 1626: instruction_expm(struct_processus *s_etat_processus)
 1627: {
 1628:     struct_liste_chainee            *l_element_courant;
 1629:     struct_liste_chainee            *l_element_precedent;
 1630: 
 1631:     struct_objet                    *s_copie_argument;
 1632:     struct_objet                    *s_objet_argument;
 1633:     struct_objet                    *s_objet_resultat;
 1634: 
 1635:     (*s_etat_processus).erreur_execution = d_ex;
 1636: 
 1637:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1638:     {
 1639:         printf("\n  EXPM ");
 1640: 
 1641:         if ((*s_etat_processus).langue == 'F')
 1642:         {
 1643:             printf("(exponentielle moins un)\n\n");
 1644:         }
 1645:         else
 1646:         {
 1647:             printf("(exp - 1)\n\n");
 1648:         }
 1649: 
 1650:         printf("    1: %s, %s\n", d_INT, d_REL);
 1651:         printf("->  1: %s\n\n", d_REL);
 1652: 
 1653:         printf("    1: %s\n", d_CPL);
 1654:         printf("->  1: %s\n\n", d_CPL);
 1655: 
 1656:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1657:         printf("->  1: %s\n\n", d_ALG);
 1658: 
 1659:         printf("    1: %s\n", d_RPN);
 1660:         printf("->  1: %s\n", d_RPN);
 1661: 
 1662:         return;
 1663:     }
 1664:     else if ((*s_etat_processus).test_instruction == 'Y')
 1665:     {
 1666:         (*s_etat_processus).nombre_arguments = 1;
 1667:         return;
 1668:     }
 1669: 
 1670:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1671:     {
 1672:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1673:         {
 1674:             return;
 1675:         }
 1676:     }
 1677: 
 1678:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1679:             &s_objet_argument) == d_erreur)
 1680:     {
 1681:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1682:         return;
 1683:     }
 1684: 
 1685: /*
 1686: --------------------------------------------------------------------------------
 1687:   Exponentielle (-1) d'un entier
 1688: --------------------------------------------------------------------------------
 1689: */
 1690: 
 1691:     if ((*s_objet_argument).type == INT)
 1692:     {
 1693:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1694:         {
 1695:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1696:             return;
 1697:         }
 1698: 
 1699:         (*((real8 *) (*s_objet_resultat).objet)) =
 1700:                 expm1((real8) (*((integer8 *) (*s_objet_argument).objet)));
 1701:     }
 1702: 
 1703: /*
 1704: --------------------------------------------------------------------------------
 1705:   Exponentielle (-1) d'un réel
 1706: --------------------------------------------------------------------------------
 1707: */
 1708: 
 1709:     else if ((*s_objet_argument).type == REL)
 1710:     {
 1711:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1712:         {
 1713:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1714:             return;
 1715:         }
 1716: 
 1717:         (*((real8 *) (*s_objet_resultat).objet)) =
 1718:                 expm1(((*((real8 *) (*s_objet_argument).objet))));
 1719:     }
 1720: 
 1721: /*
 1722: --------------------------------------------------------------------------------
 1723:   Exponentielle (-1) d'un nom
 1724: --------------------------------------------------------------------------------
 1725: */
 1726: 
 1727:     else if ((*s_objet_argument).type == NOM)
 1728:     {
 1729:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 1730:         {
 1731:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1732:             return;
 1733:         }
 1734: 
 1735:         if (((*s_objet_resultat).objet =
 1736:                 allocation_maillon(s_etat_processus)) == NULL)
 1737:         {
 1738:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1739:             return;
 1740:         }
 1741: 
 1742:         l_element_courant = (*s_objet_resultat).objet;
 1743: 
 1744:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1745:                 == NULL)
 1746:         {
 1747:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1748:             return;
 1749:         }
 1750: 
 1751:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1752:                 .nombre_arguments = 0;
 1753:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1754:                 .fonction = instruction_vers_niveau_superieur;
 1755: 
 1756:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1757:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1758:         {
 1759:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1760:             return;
 1761:         }
 1762: 
 1763:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1764:                 .nom_fonction, "<<");
 1765: 
 1766:         if (((*l_element_courant).suivant =
 1767:                 allocation_maillon(s_etat_processus)) == NULL)
 1768:         {
 1769:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1770:             return;
 1771:         }
 1772: 
 1773:         l_element_courant = (*l_element_courant).suivant;
 1774:         (*l_element_courant).donnee = s_objet_argument;
 1775: 
 1776:         if (((*l_element_courant).suivant =
 1777:                 allocation_maillon(s_etat_processus)) == NULL)
 1778:         {
 1779:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1780:             return;
 1781:         }
 1782: 
 1783:         l_element_courant = (*l_element_courant).suivant;
 1784: 
 1785:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1786:                 == NULL)
 1787:         {
 1788:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1789:             return;
 1790:         }
 1791: 
 1792:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1793:                 .nombre_arguments = 1;
 1794:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1795:                 .fonction = instruction_expm;
 1796: 
 1797:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1798:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 1799:         {
 1800:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1801:             return;
 1802:         }
 1803:             
 1804:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1805:                 .nom_fonction, "EXPM");
 1806: 
 1807:         if (((*l_element_courant).suivant =
 1808:                 allocation_maillon(s_etat_processus)) == NULL)
 1809:         {
 1810:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1811:             return;
 1812:         }
 1813: 
 1814:         l_element_courant = (*l_element_courant).suivant;
 1815: 
 1816:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1817:                 == NULL)
 1818:         {
 1819:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1820:             return;
 1821:         }
 1822: 
 1823:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1824:                 .nombre_arguments = 0;
 1825:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1826:                 .fonction = instruction_vers_niveau_inferieur;
 1827: 
 1828:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1829:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1830:         {
 1831:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1832:             return;
 1833:         }
 1834: 
 1835:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1836:                 .nom_fonction, ">>");
 1837: 
 1838:         (*l_element_courant).suivant = NULL;
 1839:         s_objet_argument = NULL;
 1840:     }
 1841: 
 1842: /*
 1843: --------------------------------------------------------------------------------
 1844:   Exponentielle (-1) d'une expression
 1845: --------------------------------------------------------------------------------
 1846: */
 1847: 
 1848:     else if (((*s_objet_argument).type == ALG) ||
 1849:             ((*s_objet_argument).type == RPN))
 1850:     {
 1851:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1852:                 s_objet_argument, 'N')) == NULL)
 1853:         {
 1854:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1855:             return;
 1856:         }
 1857: 
 1858:         l_element_courant = (struct_liste_chainee *)
 1859:                 (*s_copie_argument).objet;
 1860:         l_element_precedent = l_element_courant;
 1861: 
 1862:         while((*l_element_courant).suivant != NULL)
 1863:         {
 1864:             l_element_precedent = l_element_courant;
 1865:             l_element_courant = (*l_element_courant).suivant;
 1866:         }
 1867: 
 1868:         if (((*l_element_precedent).suivant =
 1869:                 allocation_maillon(s_etat_processus)) == NULL)
 1870:         {
 1871:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1872:             return;
 1873:         }
 1874: 
 1875:         if (((*(*l_element_precedent).suivant).donnee =
 1876:                 allocation(s_etat_processus, FCT)) == NULL)
 1877:         {
 1878:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1879:             return;
 1880:         }
 1881: 
 1882:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1883:                 .donnee).objet)).nombre_arguments = 1;
 1884:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1885:                 .donnee).objet)).fonction = instruction_expm;
 1886: 
 1887:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1888:                 .suivant).donnee).objet)).nom_fonction =
 1889:                 malloc(5 * sizeof(unsigned char))) == NULL)
 1890:         {
 1891:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1892:             return;
 1893:         }
 1894: 
 1895:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1896:                 .suivant).donnee).objet)).nom_fonction, "EXPM");
 1897: 
 1898:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1899: 
 1900:         s_objet_resultat = s_copie_argument;
 1901:     }
 1902: 
 1903: /*
 1904: --------------------------------------------------------------------------------
 1905:   Fonction exponentielle (-1) impossible à réaliser
 1906: --------------------------------------------------------------------------------
 1907: */
 1908: 
 1909:     else
 1910:     {
 1911:         liberation(s_etat_processus, s_objet_argument);
 1912: 
 1913:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1914:         return;
 1915:     }
 1916: 
 1917:     liberation(s_etat_processus, s_objet_argument);
 1918: 
 1919:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1920:             s_objet_resultat) == d_erreur)
 1921:     {
 1922:         return;
 1923:     }
 1924: 
 1925:     return;
 1926: }
 1927: 
 1928: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>