File:  [local] / rpl / src / instructions_e1.c
Revision 1.7: download - view: text, annotated - select for diffs - revision graph
Wed Apr 21 13:45:47 2010 UTC (14 years ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la 4.0.15 !

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

CVSweb interface <joel.bertrand@systella.fr>