File:  [local] / rpl / src / instructions_t1.c
Revision 1.75: download - view: text, annotated - select for diffs - revision graph
Fri Jan 10 11:15:48 2020 UTC (4 years, 3 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_32, HEAD
Modification du copyright.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.32
    4:   Copyright (C) 1989-2020 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 'type'
   29: ================================================================================
   30:   Entrées : structure processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_type(struct_processus *s_etat_processus)
   40: {
   41:     struct_objet                        *s_objet_argument;
   42:     struct_objet                        *s_objet_resultat;
   43: 
   44:     (*s_etat_processus).erreur_execution = d_ex;
   45: 
   46:     if ((*s_etat_processus).affichage_arguments == 'Y')
   47:     {
   48:         printf("\n  TYPE ");
   49: 
   50:         if ((*s_etat_processus).langue == 'F')
   51:         {
   52:             printf("(type d'objet)\n\n");
   53:         }
   54:         else
   55:         {
   56:             printf("(object type)\n\n");
   57:         }
   58: 
   59:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
   60:                 "       %s, %s, %s, %s, %s,\n"
   61:                 "       %s, %s, %s, %s, %s,\n"
   62:                 "       %s, %s, %s, %s,\n"
   63:                 "       %s, %s, %s, %s\n"
   64:                 "       %s\n",
   65:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
   66:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB, d_SCK,
   67:                 d_PRC, d_TAB, d_SQL, d_MTX, d_SPH, d_REC);
   68:         printf("->  1: %s\n\n", d_INT);
   69: 
   70:         if ((*s_etat_processus).langue == 'F')
   71:         {
   72:             printf("  Valeurs renvoyées : \n\n");
   73:             printf("    0  : scalaire (entier ou réel)\n");
   74:             printf("    1  : complexe\n");
   75:             printf("    2  : chaîne de caractères\n");
   76:             printf("    3  : vecteur ou matrice de scalaires\n");
   77:             printf("    4  : vecteur ou matrice de complexes\n");
   78:             printf("    5  : liste\n");
   79:             printf("    6  : adresse\n");
   80:             printf("    7  : nom\n");
   81:             printf("    8  : expression en notation polonaire inversée\n");
   82:             printf("    9  : expression algébrique\n");
   83:             printf("    10 : entier binaire\n");
   84:             printf("    11 : descripteur de fichier\n");
   85:             printf("    12 : descripteur de bibliothèque partagée\n");
   86:             printf("    13 : descripteur de socket\n");
   87:             printf("    14 : processus\n");
   88:             printf("    15 : fonction\n");
   89:             printf("    16 : table\n");
   90:             printf("    17 : connecteur SQL\n");
   91:             printf("    18 : mutex\n");
   92:             printf("    19 : sémaphore\n");
   93:             printf("    20 : enregistrement\n");
   94:         }
   95:         else
   96:         {
   97:             printf("  Returned values : \n\n");
   98:             printf("    0  : scalar, integer or real number\n");
   99:             printf("    1  : complex\n");
  100:             printf("    2  : string\n");
  101:             printf("    3  : scalar vector or scalar matrix\n");
  102:             printf("    4  : complex vector or complex matrix\n");
  103:             printf("    5  : list\n");
  104:             printf("    6  : address\n");
  105:             printf("    7  : name\n");
  106:             printf("    8  : RPN expression\n");
  107:             printf("    9  : algebraic expression\n");
  108:             printf("    10 : binary integer\n");
  109:             printf("    11 : file descriptor\n");
  110:             printf("    12 : shared library descriptor\n");
  111:             printf("    13 : socket descriptor\n");
  112:             printf("    14 : process\n");
  113:             printf("    15 : function\n");
  114:             printf("    16 : table\n");
  115:             printf("    17 : SQL connector\n");
  116:             printf("    18 : mutex\n");
  117:             printf("    19 : semaphore\n");
  118:             printf("    20 : record\n");
  119:         }
  120: 
  121:         return;
  122:     }
  123:     else if ((*s_etat_processus).test_instruction == 'Y')
  124:     {
  125:         (*s_etat_processus).nombre_arguments = -1;
  126:         return;
  127:     }
  128: 
  129:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  130:     {
  131:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  132:         {
  133:             return;
  134:         }
  135:     }
  136: 
  137:     if (depilement(s_etat_processus, &((*s_etat_processus)
  138:                 .l_base_pile), &s_objet_argument) == d_erreur)
  139:     {
  140:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  141:         return;
  142:     }
  143: 
  144:     if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
  145:     {
  146:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  147:         return;
  148:     }
  149: 
  150:     if (((*s_objet_argument).type == INT) ||
  151:             ((*s_objet_argument).type == REL))
  152:     {
  153:         (*((integer8 *) (*s_objet_resultat).objet)) = 0;
  154:     }
  155:     else if ((*s_objet_argument).type == CPL)
  156:     {
  157:         (*((integer8 *) (*s_objet_resultat).objet)) = 1;
  158:     }
  159:     else if ((*s_objet_argument).type == CHN)
  160:     {
  161:         (*((integer8 *) (*s_objet_resultat).objet)) = 2;
  162:     }
  163:     else if (((*s_objet_argument).type == VIN) ||
  164:             ((*s_objet_argument).type == VRL) ||
  165:             ((*s_objet_argument).type == MIN) ||
  166:             ((*s_objet_argument).type == MRL))
  167:     {
  168:         (*((integer8 *) (*s_objet_resultat).objet)) = 3;
  169:     }
  170:     else if (((*s_objet_argument).type == VCX) ||
  171:             ((*s_objet_argument).type == MCX))
  172:     {
  173:         (*((integer8 *) (*s_objet_resultat).objet)) = 4;
  174:     }
  175:     else if ((*s_objet_argument).type == LST)
  176:     {
  177:         (*((integer8 *) (*s_objet_resultat).objet)) = 5;
  178:     }
  179:     else if ((*s_objet_argument).type == ADR)
  180:     {
  181:         (*((integer8 *) (*s_objet_resultat).objet)) = 6;
  182:     }
  183:     else if ((*s_objet_argument).type == NOM)
  184:     {
  185:         (*((integer8 *) (*s_objet_resultat).objet)) = 7;
  186:     }
  187:     else if ((*s_objet_argument).type == RPN)
  188:     {
  189:         (*((integer8 *) (*s_objet_resultat).objet)) = 8;
  190:     }
  191:     else if ((*s_objet_argument).type == ALG)
  192:     {
  193:         (*((integer8 *) (*s_objet_resultat).objet)) = 9;
  194:     }
  195:     else if ((*s_objet_argument).type == BIN)
  196:     {
  197:         (*((integer8 *) (*s_objet_resultat).objet)) = 10;
  198:     }
  199:     else if ((*s_objet_argument).type == FCH)
  200:     {
  201:         (*((integer8 *) (*s_objet_resultat).objet)) = 11;
  202:     }
  203:     else if ((*s_objet_argument).type == SLB)
  204:     {
  205:         (*((integer8 *) (*s_objet_resultat).objet)) = 12;
  206:     }
  207:     else if ((*s_objet_argument).type == SCK)
  208:     {
  209:         (*((integer8 *) (*s_objet_resultat).objet)) = 13;
  210:     }
  211:     else if ((*s_objet_argument).type == PRC)
  212:     {
  213:         (*((integer8 *) (*s_objet_resultat).objet)) = 14;
  214:     }
  215:     else if ((*s_objet_argument).type == FCT)
  216:     {
  217:         (*((integer8 *) (*s_objet_resultat).objet)) = 15;
  218:     }
  219:     else if ((*s_objet_argument).type == TBL)
  220:     {
  221:         (*((integer8 *) (*s_objet_resultat).objet)) = 16;
  222:     }
  223:     else if ((*s_objet_argument).type == SQL)
  224:     {
  225:         (*((integer8 *) (*s_objet_resultat).objet)) = 17;
  226:     }
  227:     else if ((*s_objet_argument).type == MTX)
  228:     {
  229:         (*((integer8 *) (*s_objet_resultat).objet)) = 18;
  230:     }
  231:     else if ((*s_objet_argument).type == SPH)
  232:     {
  233:         (*((integer8 *) (*s_objet_resultat).objet)) = 19;
  234:     }
  235:     else if ((*s_objet_argument).type == REC)
  236:     {
  237:         (*((integer8 *) (*s_objet_resultat).objet)) = 20;
  238:     }
  239:     else if ((*s_objet_argument).type == EXT)
  240:     {
  241:         (*((integer8 *) (*s_objet_resultat).objet)) = 21;
  242:     }
  243:     else
  244:     {
  245:         /*
  246:          * Les autres types de données sont des types internes
  247:          */
  248: 
  249:         liberation(s_etat_processus, s_objet_argument);
  250: 
  251:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  252:         return;
  253:     }   
  254: 
  255:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  256:             s_objet_resultat) == d_erreur)
  257:     {
  258:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  259:         return;
  260:     }
  261: 
  262:     liberation(s_etat_processus, s_objet_argument);
  263: 
  264:     return;
  265: }
  266: 
  267: 
  268: /*
  269: ================================================================================
  270:   Fonction 'then'
  271: ================================================================================
  272:   Entrées : structure processus
  273: --------------------------------------------------------------------------------
  274:   Sorties :
  275: --------------------------------------------------------------------------------
  276:   Effets de bord : néant
  277: ================================================================================
  278: */
  279: 
  280: void
  281: instruction_then(struct_processus *s_etat_processus)
  282: {
  283:     logical1                        condition;
  284:     logical1                        drapeau_fin;
  285:     logical1                        execution;
  286: 
  287:     struct_liste_chainee            *s_registre;
  288: 
  289:     struct_liste_pile_systeme       *l_element_courant;
  290: 
  291:     struct_objet                    *s_objet;
  292: 
  293:     unsigned char                   *instruction_majuscule;
  294:     unsigned char                   *tampon;
  295: 
  296:     integer8                        niveau;
  297: 
  298:     void                            (*fonction)();
  299: 
  300:     (*s_etat_processus).erreur_execution = d_ex;
  301: 
  302:     if ((*s_etat_processus).affichage_arguments == 'Y')
  303:     {
  304:         printf("\n  THEN ");
  305: 
  306:         if ((*s_etat_processus).langue == 'F')
  307:         {
  308:             printf("(structure de contrôle)\n\n");
  309:             printf("  Utilisation :\n\n");
  310:         }
  311:         else
  312:         {
  313:             printf("(control statement)\n\n");
  314:             printf("  Usage:\n\n");
  315:         }
  316: 
  317:         printf("    IF(ERR)\n");
  318:         printf("        (expression test 1)\n");
  319:         printf("    THEN\n");
  320:         printf("        (expression 1)\n");
  321:         printf("    [ELSEIF\n");
  322:         printf("        (expression test 2)\n");
  323:         printf("    THEN\n");
  324:         printf("        (expression 2)]\n");
  325:         printf("    ...\n");
  326:         printf("    [ELSE\n");
  327:         printf("        (expression n)]\n");
  328:         printf("    END\n\n");
  329: 
  330:         printf("    SELECT (expression test)\n");
  331:         printf("        CASE (clause 1) THEN (expression 1) END\n");
  332:         printf("        CASE (clause 2) THEN (expression 2) END\n");
  333:         printf("        ...\n");
  334:         printf("        CASE (clause n) THEN (expression n) END\n");
  335:         printf("    DEFAULT\n");
  336:         printf("        (expression)\n");
  337:         printf("    END\n\n");
  338: 
  339:         printf("    SELECT (expression test)\n");
  340:         printf("        CASE (clause 1) THEN (expression 1) END\n");
  341:         printf("        (expression)\n");
  342:         printf("        CASE (clause 2) THEN (expression 2) END\n");
  343:         printf("    END\n");
  344: 
  345:         return;
  346:     }
  347:     else if ((*s_etat_processus).test_instruction == 'Y')
  348:     {
  349:         (*s_etat_processus).nombre_arguments = -1;
  350:         return;
  351:     }
  352: 
  353:     if (((*(*s_etat_processus).l_base_pile_systeme).clause != 'I') &&
  354:         ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T') &&
  355:         ((*(*s_etat_processus).l_base_pile_systeme).clause != 'R') &&
  356:         ((*(*s_etat_processus).l_base_pile_systeme).clause != 'X') &&
  357:         ((*(*s_etat_processus).l_base_pile_systeme).clause != 'C') &&
  358:         ((*(*s_etat_processus).l_base_pile_systeme).clause != 'K'))
  359:     {
  360:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
  361:         return;
  362:     }
  363: 
  364:     /*
  365:      * Traitement des erreurs
  366:      */
  367: 
  368:     if (((*(*s_etat_processus).l_base_pile_systeme).clause == 'R') ||
  369:             ((*(*s_etat_processus).l_base_pile_systeme).clause == 'X'))
  370:     {
  371:         if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
  372:         {
  373:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  374:             return;
  375:         }
  376: 
  377:         if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'R')
  378:         {
  379: 
  380:             /*
  381:              * Erreur à traiter : on saute jusques au ELSE ou au END
  382:              * correspondant.
  383:              */
  384: 
  385:             (*((integer8 *) (*s_objet).objet)) = 0;
  386:         }
  387:         else
  388:         {
  389:             (*((integer8 *) (*s_objet).objet)) = -1;
  390:         }
  391: 
  392:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  393:                 s_objet) == d_erreur)
  394:         {
  395:             return;
  396:         }
  397: 
  398:         (*s_etat_processus).arret_si_exception = (*(*s_etat_processus)
  399:                 .l_base_pile_systeme).arret_si_exception;
  400:     }
  401: 
  402:     /*
  403:      * Traitement standard de l'instruction 'THEN'
  404:      */
  405: 
  406:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  407:     {
  408:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  409:         {
  410:             return;
  411:         }
  412:     }
  413: 
  414:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  415:             &s_objet) == d_erreur)
  416:     {
  417:         return;
  418:     }
  419: 
  420:     if (((*s_objet).type == INT) || ((*s_objet).type == REL))
  421:     {
  422:         if ((*s_objet).type == INT)
  423:         {
  424:             condition = ((*((integer8 *) (*s_objet).objet)) == 0)
  425:                     ? d_faux : d_vrai;
  426:         }
  427:         else
  428:         {
  429:             condition = ((*((real8 *) (*s_objet).objet)) == 0)
  430:                     ? d_faux : d_vrai;
  431:         }
  432: 
  433:         if (condition == d_vrai)
  434:         {
  435: 
  436:             /*
  437:              * condition == d_vrai : exécution de ce qui se trouve entre
  438:              * THEN et ELSE ou END.
  439:              */
  440: 
  441:             if (((*(*s_etat_processus).l_base_pile_systeme).clause ==
  442:                     'I') || ((*(*s_etat_processus).l_base_pile_systeme).clause
  443:                     == 'X'))
  444:             {
  445:                 (*(*s_etat_processus).l_base_pile_systeme).clause = 'T';
  446:             }
  447:             else
  448:             {
  449:                 if ((*s_etat_processus).l_base_pile_systeme == NULL)
  450:                 {
  451:                     (*s_etat_processus).erreur_systeme = d_es_pile_vide;
  452:                     return;
  453:                 }
  454: 
  455:                 l_element_courant = (*(*s_etat_processus).l_base_pile_systeme)
  456:                         .suivant;
  457: 
  458:                 while(l_element_courant != NULL)
  459:                 {
  460:                     if ((*l_element_courant).clause == 'K')
  461:                     {
  462:                         (*l_element_courant).clause = 'Q';
  463:                         break;
  464:                     }
  465: 
  466:                     l_element_courant = (*l_element_courant).suivant;
  467:                 }
  468:             }
  469:         }
  470:         else
  471:         {
  472:             /*
  473:              * condition == d_faux : saut à END ou exécution de ce qui se
  474:              * trouve entre ELSE et END
  475:              */
  476: 
  477:             if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T')
  478:             {
  479:                 /*
  480:                  * Traitement de ELSEIF
  481:                  */
  482: 
  483:                 if (((*(*s_etat_processus).l_base_pile_systeme).clause !=
  484:                         'K') && ((*(*s_etat_processus).l_base_pile_systeme)
  485:                         .clause != 'C'))
  486:                 {
  487:                     (*(*s_etat_processus).l_base_pile_systeme).clause = 'E';
  488:                 }
  489:             }
  490: 
  491:             niveau = 0;
  492:             drapeau_fin = d_faux;
  493: 
  494:             if ((*s_etat_processus).mode_execution_programme == 'Y')
  495:             {
  496:                 tampon = (*s_etat_processus).instruction_courante;
  497: 
  498:                 do
  499:                 {
  500:                     if (recherche_instruction_suivante(s_etat_processus)
  501:                             == d_erreur)
  502:                     {
  503:                         liberation(s_etat_processus, s_objet);
  504: 
  505:                         if ((*s_etat_processus).instruction_courante != NULL)
  506:                         {
  507:                             free((*s_etat_processus).instruction_courante);
  508:                         }
  509: 
  510:                         (*s_etat_processus).instruction_courante = tampon;
  511:                         (*s_etat_processus).erreur_execution =
  512:                                 d_ex_erreur_traitement_condition;
  513:                         return;
  514:                     }
  515: 
  516:                     if ((instruction_majuscule = conversion_majuscule(
  517:                             s_etat_processus,
  518:                             (*s_etat_processus).instruction_courante)) == NULL)
  519:                     {
  520:                         liberation(s_etat_processus, s_objet);
  521: 
  522:                         free((*s_etat_processus).instruction_courante);
  523:                         (*s_etat_processus).instruction_courante = tampon;
  524:                         (*s_etat_processus).erreur_systeme =
  525:                                 d_es_allocation_memoire;
  526:                         return;
  527:                     }
  528: 
  529:                     if (niveau == 0)
  530:                     {
  531:                         if (((*(*s_etat_processus).l_base_pile_systeme)
  532:                                 .clause != 'K') && ((*(*s_etat_processus)
  533:                                 .l_base_pile_systeme) .clause != 'C'))
  534:                         {
  535: 
  536:                             /*
  537:                              * Traitement de IF/THEN/ELSEIF/THEN/ELSE/END
  538:                              */
  539: 
  540:                             if ((strcmp(instruction_majuscule, "END") == 0) ||
  541:                                     (strcmp(instruction_majuscule, "ELSE")
  542:                                     == 0) || (strcmp(instruction_majuscule,
  543:                                     "ELSEIF") == 0))
  544:                             {
  545:                                 (*s_etat_processus).position_courante
  546:                                         -= (integer8) (strlen(
  547:                                         instruction_majuscule) + 1);
  548:                                 drapeau_fin = d_vrai;
  549:                             }
  550:                             else
  551:                             {
  552:                                 drapeau_fin = d_faux;
  553:                             }
  554:                         }
  555:                         else
  556:                         {
  557:                             /*
  558:                              * Traitement de CASE/THEN/END
  559:                              */
  560: 
  561:                             if (strcmp(instruction_majuscule, "ELSE") == 0)
  562:                             {
  563:                                 liberation(s_etat_processus, s_objet);
  564: 
  565:                                 free((*s_etat_processus).instruction_courante);
  566:                                 free(instruction_majuscule);
  567: 
  568:                                 (*s_etat_processus).instruction_courante =
  569:                                         tampon;
  570:                                 (*s_etat_processus).erreur_execution =
  571:                                         d_ex_erreur_traitement_condition;
  572:                                 return;
  573:                             }
  574:                             else if (strcmp(instruction_majuscule, "END") == 0)
  575:                             {
  576:                                 instruction_end(s_etat_processus);
  577:                                 drapeau_fin = d_vrai;
  578:                             }
  579:                             else
  580:                             {
  581:                                 drapeau_fin = d_faux;
  582:                             }
  583:                         }
  584:                     }
  585:                     else
  586:                     {
  587:                         drapeau_fin = d_faux;
  588:                     }
  589: 
  590:                     if ((strcmp(instruction_majuscule, "CASE") == 0) ||
  591:                             (strcmp(instruction_majuscule, "DO") == 0) ||
  592:                             (strcmp(instruction_majuscule, "IF") == 0) ||
  593:                             (strcmp(instruction_majuscule, "IFERR") == 0) ||
  594:                             (strcmp(instruction_majuscule, "SELECT") == 0) ||
  595:                             (strcmp(instruction_majuscule, "WHILE") == 0))
  596:                     {
  597:                         niveau++;
  598:                     }
  599:                     else if (strcmp(instruction_majuscule, "END") == 0)
  600:                     {
  601:                         niveau--;
  602:                     }
  603: 
  604:                     free(instruction_majuscule);
  605:                     free((*s_etat_processus).instruction_courante);
  606:                 } while(drapeau_fin == d_faux);
  607: 
  608:                 (*s_etat_processus).instruction_courante = tampon;
  609:             }
  610:             else
  611:             {
  612:                 /*
  613:                  * Vérification du pointeur de prédiction de saut.
  614:                  */
  615: 
  616:                 if (pthread_mutex_lock(&((*(*(*s_etat_processus)
  617:                         .expression_courante).donnee).mutex)) != 0)
  618:                 {
  619:                     (*s_etat_processus).erreur_systeme = d_es_processus;
  620:                     return;
  621:                 }
  622: 
  623:                 if ((*((struct_fonction *) (*(*(*s_etat_processus)
  624:                         .expression_courante).donnee).objet)).prediction_saut
  625:                         != NULL)
  626:                 {
  627:                     s_registre = (*s_etat_processus).expression_courante;
  628: 
  629:                     (*s_etat_processus).expression_courante =
  630:                             (struct_liste_chainee *)
  631:                             (*((struct_fonction *) (*(*(*s_etat_processus)
  632:                             .expression_courante).donnee).objet))
  633:                             .prediction_saut;
  634:                     fonction = (*((struct_fonction *)
  635:                             (*(*(*s_etat_processus).expression_courante)
  636:                             .donnee).objet)).fonction;
  637:                     execution = (*((struct_fonction *)
  638:                             (*(*s_registre).donnee).objet))
  639:                             .prediction_execution;
  640: 
  641:                     if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
  642:                             != 0)
  643:                     {
  644:                         (*s_etat_processus).erreur_systeme = d_es_processus;
  645:                         return;
  646:                     }
  647: 
  648:                     if (execution == d_vrai)
  649:                     {
  650:                         fonction(s_etat_processus);
  651:                     }
  652:                 }
  653:                 else
  654:                 {
  655:                     if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
  656:                             .expression_courante).donnee).mutex)) != 0)
  657:                     {
  658:                         (*s_etat_processus).erreur_systeme = d_es_processus;
  659:                         return;
  660:                     }
  661: 
  662:                     s_registre = (*s_etat_processus).expression_courante;
  663:                     execution = d_faux;
  664: 
  665:                     do
  666:                     {
  667:                         if (((*s_etat_processus).expression_courante =
  668:                                 (*(*s_etat_processus).expression_courante)
  669:                                 .suivant) == NULL)
  670:                         {
  671:                             liberation(s_etat_processus, s_objet);
  672:                             (*s_etat_processus).erreur_execution =
  673:                                     d_ex_erreur_traitement_condition;
  674:                             return;
  675:                         }
  676: 
  677:                         if ((*(*(*s_etat_processus).expression_courante)
  678:                                 .donnee).type == FCT)
  679:                         {
  680:                             fonction = (*((struct_fonction *)
  681:                                     (*(*(*s_etat_processus).expression_courante)
  682:                                     .donnee).objet)).fonction;
  683: 
  684:                             if (niveau == 0)
  685:                             {
  686:                                 if (((*(*s_etat_processus).l_base_pile_systeme)
  687:                                         .clause != 'K') &&
  688:                                         ((*(*s_etat_processus)
  689:                                         .l_base_pile_systeme).clause != 'C'))
  690:                                 {
  691:                                     /*
  692:                                      * Traitement de IF/THEN/ELSEIF/THEN/
  693:                                      * ELSE/END
  694:                                      */
  695: 
  696:                                     if ((fonction == instruction_end) ||
  697:                                             (fonction == instruction_else) ||
  698:                                             (fonction == instruction_elseif))
  699:                                     {
  700:                                         fonction(s_etat_processus);
  701:                                         execution = d_vrai;
  702:                                         drapeau_fin = d_vrai;
  703:                                     }
  704:                                     else
  705:                                     {
  706:                                         drapeau_fin = d_faux;
  707:                                     }
  708:                                 }
  709:                                 else
  710:                                 {
  711:                                     /*
  712:                                      * Traitement de CASE/THEN/END
  713:                                      */
  714: 
  715:                                     if (fonction == instruction_else)
  716:                                     {
  717:                                         liberation(s_etat_processus, s_objet);
  718: 
  719:                                         if ((drapeau_fin == d_faux) &&
  720:                                                 ((*s_etat_processus)
  721:                                                 .expression_courante != NULL))
  722:                                         {
  723:                                             (*s_etat_processus)
  724:                                                     .expression_courante
  725:                                                     = (*(*s_etat_processus)
  726:                                                     .expression_courante)
  727:                                                     .suivant;
  728:                                         }
  729: 
  730:                                         (*s_etat_processus).erreur_execution =
  731:                                             d_ex_erreur_traitement_condition;
  732:                                         return;
  733:                                     }
  734:                                     else if (fonction == instruction_end)
  735:                                     {
  736:                                         fonction(s_etat_processus);
  737:                                         execution = d_vrai;
  738:                                         drapeau_fin = d_vrai;
  739:                                     }
  740:                                     else
  741:                                     {
  742:                                         drapeau_fin = d_faux;
  743:                                     }
  744:                                 }
  745:                             }
  746:                             else
  747:                             {
  748:                                 drapeau_fin = d_faux;
  749:                             }
  750: 
  751:                             if ((fonction == instruction_case) ||
  752:                                     (fonction == instruction_do) ||
  753:                                     (fonction == instruction_if) ||
  754:                                     (fonction == instruction_iferr) ||
  755:                                     (fonction == instruction_select) ||
  756:                                     (fonction == instruction_while))
  757:                             {
  758:                                 niveau++;
  759:                             }
  760:                             else if (fonction == instruction_end)
  761:                             {
  762:                                 niveau--;
  763:                             }
  764:                         }
  765:                     } while(drapeau_fin == d_faux);
  766: 
  767:                     if (pthread_mutex_lock(&((*(*(*s_etat_processus)
  768:                             .expression_courante).donnee).mutex)) != 0)
  769:                     {
  770:                         (*s_etat_processus).erreur_systeme = d_es_processus;
  771:                         return;
  772:                     }
  773: 
  774:                     (*((struct_fonction *) (*(*s_registre).donnee).objet))
  775:                             .prediction_saut = (*s_etat_processus)
  776:                             .expression_courante;
  777:                     (*((struct_fonction *) (*(*s_registre).donnee).objet))
  778:                             .prediction_execution = execution;
  779: 
  780:                     if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
  781:                             .expression_courante).donnee).mutex)) != 0)
  782:                     {
  783:                         (*s_etat_processus).erreur_systeme = d_es_processus;
  784:                         return;
  785:                     }
  786:                 }
  787:             }
  788:         }
  789:     }
  790:     else
  791:     {
  792:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  793:         return;
  794:     }
  795: 
  796:     liberation(s_etat_processus, s_objet);
  797:     return;
  798: }
  799: 
  800: 
  801: /*
  802: ================================================================================
  803:   Fonction 'tan'
  804: ================================================================================
  805:   Entrées : pointeur sur une structure struct_processus
  806: --------------------------------------------------------------------------------
  807:   Sorties :
  808: --------------------------------------------------------------------------------
  809:   Effets de bord : néant
  810: ================================================================================
  811: */
  812: 
  813: void
  814: instruction_tan(struct_processus *s_etat_processus)
  815: {
  816:     real8                           angle;
  817: 
  818:     integer4                        erreur;
  819: 
  820:     struct_liste_chainee            *l_element_courant;
  821:     struct_liste_chainee            *l_element_precedent;
  822: 
  823:     struct_objet                    *s_copie_argument;
  824:     struct_objet                    *s_objet_argument;
  825:     struct_objet                    *s_objet_resultat;
  826: 
  827:     (*s_etat_processus).erreur_execution = d_ex;
  828: 
  829:     if ((*s_etat_processus).affichage_arguments == 'Y')
  830:     {
  831:         printf("\n  TAN ");
  832: 
  833:         if ((*s_etat_processus).langue == 'F')
  834:         {
  835:             printf("(tangente)\n\n");
  836:         }
  837:         else
  838:         {
  839:             printf("(tangent)\n\n");
  840:         }
  841: 
  842:         printf("    1: %s, %s\n", d_INT, d_REL);
  843:         printf("->  1: %s\n\n", d_REL);
  844: 
  845:         printf("    1: %s\n", d_CPL);
  846:         printf("->  1: %s\n\n", d_CPL);
  847: 
  848:         printf("    1: %s, %s\n", d_NOM, d_ALG);
  849:         printf("->  1: %s\n\n", d_ALG);
  850: 
  851:         printf("    1: %s\n", d_RPN);
  852:         printf("->  1: %s\n", d_RPN);
  853: 
  854:         return;
  855:     }
  856:     else if ((*s_etat_processus).test_instruction == 'Y')
  857:     {
  858:         (*s_etat_processus).nombre_arguments = 1;
  859:         return;
  860:     }
  861: 
  862:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  863:     {
  864:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  865:         {
  866:             return;
  867:         }
  868:     }
  869: 
  870:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  871:             &s_objet_argument) == d_erreur)
  872:     {
  873:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  874:         return;
  875:     }
  876: 
  877: /*
  878: --------------------------------------------------------------------------------
  879:   Tangente d'un entier ou d'un réel
  880: --------------------------------------------------------------------------------
  881: */
  882: 
  883:     if (((*s_objet_argument).type == INT) ||
  884:             ((*s_objet_argument).type == REL))
  885:     {
  886:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
  887:         {
  888:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  889:             return;
  890:         }
  891: 
  892:         if ((*s_objet_argument).type == INT)
  893:         {
  894:             angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
  895:         }
  896:         else
  897:         {
  898:             angle = (*((real8 *) (*s_objet_argument).objet));
  899:         }
  900: 
  901:         if (test_cfsf(s_etat_processus, 60) == d_faux)
  902:         {
  903:             conversion_degres_vers_radians(&angle);
  904:         }
  905: 
  906:         if ((cos(angle) == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai))
  907:         {
  908:             liberation(s_etat_processus, s_objet_argument);
  909:             liberation(s_etat_processus, s_objet_resultat);
  910: 
  911:             (*s_etat_processus).exception = d_ep_division_par_zero;
  912:             return;
  913:         }
  914: 
  915:         (*((real8 *) (*s_objet_resultat).objet)) = tan(angle);
  916:     }
  917: 
  918: /*
  919: --------------------------------------------------------------------------------
  920:   Tangente d'un complexe
  921: --------------------------------------------------------------------------------
  922: */
  923: 
  924:     else if ((*s_objet_argument).type == CPL)
  925:     {
  926:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
  927:         {
  928:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  929:             return;
  930:         }
  931: 
  932:         f77tan_((struct_complexe16 *) (*s_objet_argument).objet,
  933:                 (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
  934: 
  935:         if (erreur != 0)
  936:         {
  937:             liberation(s_etat_processus, s_objet_argument);
  938:             liberation(s_etat_processus, s_objet_resultat);
  939: 
  940:             (*s_etat_processus).exception = d_ep_division_par_zero;
  941:             return;
  942:         }
  943:     }
  944: 
  945: /*
  946: --------------------------------------------------------------------------------
  947:   Tangente d'un nom
  948: --------------------------------------------------------------------------------
  949: */
  950: 
  951:     else if ((*s_objet_argument).type == NOM)
  952:     {
  953:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
  954:         {
  955:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  956:             return;
  957:         }
  958: 
  959:         if (((*s_objet_resultat).objet =
  960:                 allocation_maillon(s_etat_processus)) == NULL)
  961:         {
  962:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  963:             return;
  964:         }
  965: 
  966:         l_element_courant = (*s_objet_resultat).objet;
  967: 
  968:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  969:                 == NULL)
  970:         {
  971:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  972:             return;
  973:         }
  974: 
  975:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  976:                 .nombre_arguments = 0;
  977:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  978:                 .fonction = instruction_vers_niveau_superieur;
  979: 
  980:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  981:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  982:         {
  983:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  984:             return;
  985:         }
  986: 
  987:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  988:                 .nom_fonction, "<<");
  989: 
  990:         if (((*l_element_courant).suivant =
  991:                 allocation_maillon(s_etat_processus)) == NULL)
  992:         {
  993:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  994:             return;
  995:         }
  996: 
  997:         l_element_courant = (*l_element_courant).suivant;
  998:         (*l_element_courant).donnee = s_objet_argument;
  999: 
 1000:         if (((*l_element_courant).suivant =
 1001:                 allocation_maillon(s_etat_processus)) == NULL)
 1002:         {
 1003:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1004:             return;
 1005:         }
 1006: 
 1007:         l_element_courant = (*l_element_courant).suivant;
 1008: 
 1009:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1010:                 == NULL)
 1011:         {
 1012:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1013:             return;
 1014:         }
 1015: 
 1016:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1017:                 .nombre_arguments = 1;
 1018:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1019:                 .fonction = instruction_tan;
 1020: 
 1021:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1022:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
 1023:         {
 1024:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1025:             return;
 1026:         }
 1027: 
 1028:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1029:                 .nom_fonction, "TAN");
 1030: 
 1031:         if (((*l_element_courant).suivant =
 1032:                 allocation_maillon(s_etat_processus)) == NULL)
 1033:         {
 1034:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1035:             return;
 1036:         }
 1037: 
 1038:         l_element_courant = (*l_element_courant).suivant;
 1039: 
 1040:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1041:                 == NULL)
 1042:         {
 1043:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1044:             return;
 1045:         }
 1046: 
 1047:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1048:                 .nombre_arguments = 0;
 1049:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1050:                 .fonction = instruction_vers_niveau_inferieur;
 1051: 
 1052:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1053:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1054:         {
 1055:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1056:             return;
 1057:         }
 1058: 
 1059:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1060:                 .nom_fonction, ">>");
 1061: 
 1062:         (*l_element_courant).suivant = NULL;
 1063:         s_objet_argument = NULL;
 1064:     }
 1065: 
 1066: /*
 1067: --------------------------------------------------------------------------------
 1068:   Tangente d'une expression
 1069: --------------------------------------------------------------------------------
 1070: */
 1071: 
 1072:     else if (((*s_objet_argument).type == ALG) ||
 1073:             ((*s_objet_argument).type == RPN))
 1074:     {
 1075:         if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
 1076:                 'N')) == NULL)
 1077:         {
 1078:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1079:             return;
 1080:         }
 1081: 
 1082:         l_element_courant = (struct_liste_chainee *)
 1083:                 (*s_copie_argument).objet;
 1084:         l_element_precedent = l_element_courant;
 1085: 
 1086:         while((*l_element_courant).suivant != NULL)
 1087:         {
 1088:             l_element_precedent = l_element_courant;
 1089:             l_element_courant = (*l_element_courant).suivant;
 1090:         }
 1091: 
 1092:         if (((*l_element_precedent).suivant =
 1093:                 allocation_maillon(s_etat_processus)) == NULL)
 1094:         {
 1095:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1096:             return;
 1097:         }
 1098: 
 1099:         if (((*(*l_element_precedent).suivant).donnee =
 1100:                 allocation(s_etat_processus, FCT)) == NULL)
 1101:         {
 1102:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1103:             return;
 1104:         }
 1105: 
 1106:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1107:                 .donnee).objet)).nombre_arguments = 1;
 1108:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1109:                 .donnee).objet)).fonction = instruction_tan;
 1110: 
 1111:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1112:                 .suivant).donnee).objet)).nom_fonction =
 1113:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1114:         {
 1115:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1116:             return;
 1117:         }
 1118: 
 1119:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1120:                 .suivant).donnee).objet)).nom_fonction, "TAN");
 1121: 
 1122:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1123: 
 1124:         s_objet_resultat = s_copie_argument;
 1125:     }
 1126: 
 1127: /*
 1128: --------------------------------------------------------------------------------
 1129:   Réalisation impossible de la fonction tangente
 1130: --------------------------------------------------------------------------------
 1131: */
 1132: 
 1133:     else
 1134:     {
 1135:         liberation(s_etat_processus, s_objet_argument);
 1136: 
 1137:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1138:         return;
 1139:     }
 1140: 
 1141:     liberation(s_etat_processus, s_objet_argument);
 1142: 
 1143:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1144:             s_objet_resultat) == d_erreur)
 1145:     {
 1146:         return;
 1147:     }
 1148: 
 1149:     return;
 1150: }
 1151: 
 1152: 
 1153: /*
 1154: ================================================================================
 1155:   Fonction 'tanh'
 1156: ================================================================================
 1157:   Entrées : pointeur sur une structure struct_processus
 1158: --------------------------------------------------------------------------------
 1159:   Sorties :
 1160: --------------------------------------------------------------------------------
 1161:   Effets de bord : néant
 1162: ================================================================================
 1163: */
 1164: 
 1165: void
 1166: instruction_tanh(struct_processus *s_etat_processus)
 1167: {
 1168:     real8                           argument;
 1169: 
 1170:     integer4                        erreur;
 1171: 
 1172:     struct_liste_chainee            *l_element_courant;
 1173:     struct_liste_chainee            *l_element_precedent;
 1174: 
 1175:     struct_objet                    *s_copie_argument;
 1176:     struct_objet                    *s_objet_argument;
 1177:     struct_objet                    *s_objet_resultat;
 1178: 
 1179:     (*s_etat_processus).erreur_execution = d_ex;
 1180: 
 1181:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1182:     {
 1183:         printf("\n  TANH ");
 1184: 
 1185:         if ((*s_etat_processus).langue == 'F')
 1186:         {
 1187:             printf("(tangente hyperbolique)\n\n");
 1188:         }
 1189:         else
 1190:         {
 1191:             printf("(hyperbolic tangent)\n\n");
 1192:         }
 1193: 
 1194:         printf("    1: %s, %s\n", d_INT, d_REL);
 1195:         printf("->  1: %s\n\n", d_INT);
 1196: 
 1197:         printf("    1: %s\n", d_CPL);
 1198:         printf("->  1: %s\n\n", d_CPL);
 1199: 
 1200:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1201:         printf("->  1: %s\n\n", d_ALG);
 1202: 
 1203:         printf("    1: %s\n", d_RPN);
 1204:         printf("->  1: %s\n", d_RPN);
 1205: 
 1206:         return;
 1207:     }
 1208:     else if ((*s_etat_processus).test_instruction == 'Y')
 1209:     {
 1210:         (*s_etat_processus).nombre_arguments = 1;
 1211:         return;
 1212:     }
 1213: 
 1214:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1215:     {
 1216:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1217:         {
 1218:             return;
 1219:         }
 1220:     }
 1221: 
 1222:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1223:             &s_objet_argument) == d_erreur)
 1224:     {
 1225:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1226:         return;
 1227:     }
 1228: 
 1229: /*
 1230: --------------------------------------------------------------------------------
 1231:   Tangente hyperbolique d'un entier ou d'un réel
 1232: --------------------------------------------------------------------------------
 1233: */
 1234: 
 1235:     if (((*s_objet_argument).type == INT) ||
 1236:             ((*s_objet_argument).type == REL))
 1237:     {
 1238:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1239:         {
 1240:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1241:             return;
 1242:         }
 1243: 
 1244:         if ((*s_objet_argument).type == INT)
 1245:         {
 1246:             argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
 1247:         }
 1248:         else
 1249:         {
 1250:             argument = (*((real8 *) (*s_objet_argument).objet));
 1251:         }
 1252: 
 1253:         (*((real8 *) (*s_objet_resultat).objet)) = tanh(argument);
 1254:     }
 1255: 
 1256: /*
 1257: --------------------------------------------------------------------------------
 1258:   Tangente hyperbolique d'un complexe
 1259: --------------------------------------------------------------------------------
 1260: */
 1261: 
 1262:     else if ((*s_objet_argument).type == CPL)
 1263:     {
 1264:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
 1265:         {
 1266:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1267:             return;
 1268:         }
 1269: 
 1270:         f77tanh_((struct_complexe16 *) (*s_objet_argument).objet,
 1271:                 (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
 1272: 
 1273:         if (erreur != 0)
 1274:         {
 1275:             liberation(s_etat_processus, s_objet_argument);
 1276:             liberation(s_etat_processus, s_objet_resultat);
 1277: 
 1278:             (*s_etat_processus).exception = d_ep_division_par_zero;
 1279:             return;
 1280:         }
 1281:     }
 1282: 
 1283: /*
 1284: --------------------------------------------------------------------------------
 1285:   Tangente hyperbolique d'un nom
 1286: --------------------------------------------------------------------------------
 1287: */
 1288: 
 1289:     else if ((*s_objet_argument).type == NOM)
 1290:     {
 1291:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 1292:         {
 1293:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1294:             return;
 1295:         }
 1296: 
 1297:         if (((*s_objet_resultat).objet =
 1298:                 allocation_maillon(s_etat_processus)) == NULL)
 1299:         {
 1300:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1301:             return;
 1302:         }
 1303: 
 1304:         l_element_courant = (*s_objet_resultat).objet;
 1305: 
 1306:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1307:                 == NULL)
 1308:         {
 1309:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1310:             return;
 1311:         }
 1312: 
 1313:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1314:                 .nombre_arguments = 0;
 1315:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1316:                 .fonction = instruction_vers_niveau_superieur;
 1317: 
 1318:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1319:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1320:         {
 1321:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1322:             return;
 1323:         }
 1324: 
 1325:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1326:                 .nom_fonction, "<<");
 1327: 
 1328:         if (((*l_element_courant).suivant =
 1329:                 allocation_maillon(s_etat_processus)) == NULL)
 1330:         {
 1331:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1332:             return;
 1333:         }
 1334: 
 1335:         l_element_courant = (*l_element_courant).suivant;
 1336:         (*l_element_courant).donnee = s_objet_argument;
 1337: 
 1338:         if (((*l_element_courant).suivant =
 1339:                 allocation_maillon(s_etat_processus)) == NULL)
 1340:         {
 1341:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1342:             return;
 1343:         }
 1344: 
 1345:         l_element_courant = (*l_element_courant).suivant;
 1346: 
 1347:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1348:                 == NULL)
 1349:         {
 1350:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1351:             return;
 1352:         }
 1353: 
 1354:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1355:                 .nombre_arguments = 1;
 1356:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1357:                 .fonction = instruction_tanh;
 1358: 
 1359:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1360:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 1361:         {
 1362:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1363:             return;
 1364:         }
 1365: 
 1366:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1367:                 .nom_fonction, "TANH");
 1368: 
 1369:         if (((*l_element_courant).suivant =
 1370:                 allocation_maillon(s_etat_processus)) == NULL)
 1371:         {
 1372:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1373:             return;
 1374:         }
 1375: 
 1376:         l_element_courant = (*l_element_courant).suivant;
 1377: 
 1378:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1379:                 == NULL)
 1380:         {
 1381:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1382:             return;
 1383:         }
 1384: 
 1385:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1386:                 .nombre_arguments = 0;
 1387:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1388:                 .fonction = instruction_vers_niveau_inferieur;
 1389: 
 1390:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1391:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1392:         {
 1393:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1394:             return;
 1395:         }
 1396: 
 1397:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1398:                 .nom_fonction, ">>");
 1399: 
 1400:         (*l_element_courant).suivant = NULL;
 1401:         s_objet_argument = NULL;
 1402:     }
 1403: 
 1404: /*
 1405: --------------------------------------------------------------------------------
 1406:   Tangente hyperbolique d'une expression
 1407: --------------------------------------------------------------------------------
 1408: */
 1409: 
 1410:     else if (((*s_objet_argument).type == ALG) ||
 1411:             ((*s_objet_argument).type == RPN))
 1412:     {
 1413:         if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
 1414:                 'N')) == NULL)
 1415:         {
 1416:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1417:             return;
 1418:         }
 1419: 
 1420:         l_element_courant = (struct_liste_chainee *)
 1421:                 (*s_copie_argument).objet;
 1422:         l_element_precedent = l_element_courant;
 1423: 
 1424:         while((*l_element_courant).suivant != NULL)
 1425:         {
 1426:             l_element_precedent = l_element_courant;
 1427:             l_element_courant = (*l_element_courant).suivant;
 1428:         }
 1429: 
 1430:         if (((*l_element_precedent).suivant =
 1431:                 allocation_maillon(s_etat_processus)) == NULL)
 1432:         {
 1433:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1434:             return;
 1435:         }
 1436: 
 1437:         if (((*(*l_element_precedent).suivant).donnee =
 1438:                 allocation(s_etat_processus, FCT)) == NULL)
 1439:         {
 1440:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1441:             return;
 1442:         }
 1443: 
 1444:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1445:                 .donnee).objet)).nombre_arguments = 1;
 1446:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1447:                 .donnee).objet)).fonction = instruction_tanh;
 1448: 
 1449:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1450:                 .suivant).donnee).objet)).nom_fonction =
 1451:                 malloc(5 * sizeof(unsigned char))) == NULL)
 1452:         {
 1453:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1454:             return;
 1455:         }
 1456: 
 1457:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1458:                 .suivant).donnee).objet)).nom_fonction, "TANH");
 1459: 
 1460:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1461: 
 1462:         s_objet_resultat = s_copie_argument;
 1463:     }
 1464: 
 1465: /*
 1466: --------------------------------------------------------------------------------
 1467:   Réalisation impossible de la fonction tangente hyperbolique
 1468: --------------------------------------------------------------------------------
 1469: */
 1470: 
 1471:     else
 1472:     {
 1473:         liberation(s_etat_processus, s_objet_argument);
 1474: 
 1475:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1476:         return;
 1477:     }
 1478: 
 1479:     liberation(s_etat_processus, s_objet_argument);
 1480: 
 1481:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1482:             s_objet_resultat) == d_erreur)
 1483:     {
 1484:         return;
 1485:     }
 1486: 
 1487:     return;
 1488: }
 1489: 
 1490: 
 1491: /*
 1492: ================================================================================
 1493:   Fonction 'true'
 1494: ================================================================================
 1495:   Entrées : structure processus
 1496: --------------------------------------------------------------------------------
 1497:   Sorties :
 1498: --------------------------------------------------------------------------------
 1499:   Effets de bord : néant
 1500: ================================================================================
 1501: */
 1502: 
 1503: void
 1504: instruction_true(struct_processus *s_etat_processus)
 1505: {
 1506:     struct_objet                    *s_objet;
 1507: 
 1508:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1509:     {
 1510:         printf("\n  TRUE ");
 1511: 
 1512:         if ((*s_etat_processus).langue == 'F')
 1513:         {
 1514:             printf("(valeur vraie)\n\n");
 1515:         }
 1516:         else
 1517:         {
 1518:             printf("(true value)\n\n");
 1519:         }
 1520: 
 1521:         printf("->  1: %s\n", d_INT);
 1522: 
 1523:         return;
 1524:     }
 1525:     else if ((*s_etat_processus).test_instruction == 'Y')
 1526:     {
 1527:         (*s_etat_processus).nombre_arguments = -1;
 1528:         return;
 1529:     }
 1530: 
 1531:     if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
 1532:     {
 1533:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1534:         return;
 1535:     }
 1536: 
 1537:     (*((integer8 *) (*s_objet).objet)) = -1;
 1538: 
 1539:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1540:             s_objet) == d_erreur)
 1541:     {
 1542:         return;
 1543:     }
 1544: 
 1545:     return;
 1546: }
 1547: 
 1548: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>