File:  [local] / rpl / src / instructions_t1.c
Revision 1.60: download - view: text, annotated - select for diffs - revision graph
Thu Nov 26 11:44:40 2015 UTC (8 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_24, HEAD
Mise à jour de Lapack (3.6.0) et du numéro de version du RPL/2.

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

CVSweb interface <joel.bertrand@systella.fr>