File:  [local] / rpl / src / instructions_t1.c
Revision 1.66: download - view: text, annotated - select for diffs - revision graph
Thu Aug 3 17:17:49 2017 UTC (6 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_28, HEAD
En route pour la 4.1.28.

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

CVSweb interface <joel.bertrand@systella.fr>