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

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.32
    4:   Copyright (C) 1989-2020 Dr. BERTRAND Joël
    5: 
    6:   This file is part of RPL/2.
    7: 
    8:   RPL/2 is free software; you can redistribute it and/or modify it
    9:   under the terms of the CeCILL V2 License as published by the french
   10:   CEA, CNRS and INRIA.
   11:  
   12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
   13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
   15:   for more details.
   16:  
   17:   You should have received a copy of the CeCILL License
   18:   along with RPL/2. If not, write to info@cecill.info.
   19: ================================================================================
   20: */
   21: 
   22: 
   23: #include "rpl-conv.h"
   24: 
   25: 
   26: /*
   27: ================================================================================
   28:   Fonction 'clear'
   29: ================================================================================
   30:   Entrées : structure processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_clear(struct_processus *s_etat_processus)
   40: {
   41:     struct_liste_chainee            *l_element_courant;
   42:     struct_liste_chainee            *l_element_suivant;
   43: 
   44:     (*s_etat_processus).erreur_execution = d_ex;
   45: 
   46:     if ((*s_etat_processus).affichage_arguments == 'Y')
   47:     {
   48:         printf("\n  CLEAR ");
   49: 
   50:         if ((*s_etat_processus).langue == 'F')
   51:         {
   52:             printf("(efface la pile)\n\n");
   53:             printf("  Aucun argument\n");
   54:         }
   55:         else
   56:         {
   57:             printf("(clear stack)\n\n");
   58:             printf("  No argument\n");
   59:         }
   60: 
   61:         return;
   62:     }
   63:     else if ((*s_etat_processus).test_instruction == 'Y')
   64:     {
   65:         (*s_etat_processus).nombre_arguments = -1;
   66:         return;
   67:     }
   68: 
   69:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
   70:     {
   71:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
   72:         {
   73:             return;
   74:         }
   75:     }
   76: 
   77:     l_element_courant = (*s_etat_processus).l_base_pile;
   78:     while(l_element_courant != NULL)
   79:     {
   80:         liberation(s_etat_processus, (*l_element_courant).donnee);
   81:         l_element_suivant = (*l_element_courant).suivant;
   82: 
   83:         // On ne libère le maillon de la chaîne. On le sauvegarde
   84:         // arbitrairement dans le tampon.
   85: 
   86:         (*l_element_courant).donnee = NULL;
   87:         (*l_element_courant).suivant = (*s_etat_processus).pile_tampon;
   88:         (*s_etat_processus).pile_tampon = l_element_courant;
   89:         (*s_etat_processus).taille_pile_tampon++;
   90: 
   91:         l_element_courant = l_element_suivant;
   92:     }
   93: 
   94:     (*s_etat_processus).l_base_pile = NULL;
   95:     (*s_etat_processus).hauteur_pile_operationnelle = 0;
   96: 
   97:     return;
   98: }
   99: 
  100: 
  101: /*
  102: ================================================================================
  103:   Fonction 'cllcd' (efface la sortie graphique)
  104: ================================================================================
  105:   Entrées : structure processus
  106: --------------------------------------------------------------------------------
  107:   Sorties :
  108: --------------------------------------------------------------------------------
  109:   Effets de bord : néant
  110: ================================================================================
  111: */
  112: 
  113: void
  114: instruction_cllcd(struct_processus *s_etat_processus)
  115: {
  116:     struct_fichier_graphique            *l_element_precedent;
  117: 
  118:     struct_marque                       *marque;
  119:     struct_marque                       *prochaine_marque;
  120: 
  121:     (*s_etat_processus).erreur_execution = d_ex;
  122: 
  123:     if ((*s_etat_processus).affichage_arguments == 'Y')
  124:     {
  125:         printf("\n  CLLCD ");
  126: 
  127:         if ((*s_etat_processus).langue == 'F')
  128:         {
  129:             printf("(efface la file graphique)\n\n");
  130:             printf("  Aucun argument\n");
  131:         }
  132:         else
  133:         {
  134:             printf("(erase the graphical queue)\n\n");
  135:             printf("  No argument\n");
  136:         }
  137: 
  138:         return;
  139:     }
  140:     else if ((*s_etat_processus).test_instruction == 'Y')
  141:     {
  142:         (*s_etat_processus).nombre_arguments = -1;
  143:         return;
  144:     }
  145: 
  146:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  147:     {
  148:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
  149:         {
  150:             return;
  151:         }
  152:     }
  153: 
  154:     while((*s_etat_processus).fichiers_graphiques != NULL)
  155:     {
  156:         if (destruction_fichier((*(*s_etat_processus).fichiers_graphiques).nom)
  157:                 == d_erreur)
  158:         {
  159:             (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
  160:             return;
  161:         }
  162: 
  163:         free((*(*s_etat_processus).fichiers_graphiques).nom);
  164: 
  165:         if ((*(*s_etat_processus).fichiers_graphiques).legende != NULL)
  166:         {
  167:             free((*(*s_etat_processus).fichiers_graphiques).legende);
  168:         }
  169: 
  170:         l_element_precedent = (*s_etat_processus).fichiers_graphiques;
  171:         (*s_etat_processus).fichiers_graphiques =
  172:                 (*(*s_etat_processus).fichiers_graphiques).suivant;
  173: 
  174:         free(l_element_precedent);
  175:     }
  176: 
  177:     if ((*s_etat_processus).entree_standard != NULL)
  178:     {
  179:         if (fprintf((*s_etat_processus).entree_standard, "quit\n") < 0)
  180:         {
  181:             (*s_etat_processus).erreur_systeme = d_es_processus;
  182:             return;
  183:         }
  184: 
  185:         if (fflush((*s_etat_processus).entree_standard) != 0)
  186:         {
  187:             (*s_etat_processus).erreur_systeme = d_es_processus;
  188:             return;
  189:         }
  190: 
  191:         if (pclose((*s_etat_processus).entree_standard) == -1)
  192:         {
  193:             (*s_etat_processus).erreur_systeme = d_es_processus;
  194:             return;
  195:         }
  196: 
  197:         (*s_etat_processus).entree_standard = NULL;
  198:     }
  199: 
  200:     free((*s_etat_processus).titre);
  201:     free((*s_etat_processus).legende);
  202:     free((*s_etat_processus).label_x);
  203:     free((*s_etat_processus).label_y);
  204:     free((*s_etat_processus).label_z);
  205: 
  206:     (*s_etat_processus).titre = malloc(sizeof(unsigned char));
  207:     (*s_etat_processus).label_x = malloc(sizeof(unsigned char));
  208:     (*s_etat_processus).label_y = malloc(sizeof(unsigned char));
  209:     (*s_etat_processus).label_z = malloc(sizeof(unsigned char));
  210:     (*s_etat_processus).legende = malloc(sizeof(unsigned char));
  211: 
  212:     if (((*s_etat_processus).titre == NULL) ||
  213:             ((*s_etat_processus).legende == NULL) ||
  214:             ((*s_etat_processus).label_x == NULL) ||
  215:             ((*s_etat_processus).label_y == NULL) ||
  216:             ((*s_etat_processus).label_z == NULL))
  217:     {
  218:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  219:         return;
  220:     }
  221: 
  222:     (*s_etat_processus).titre[0] = d_code_fin_chaine;
  223:     (*s_etat_processus).label_x[0] = d_code_fin_chaine;
  224:     (*s_etat_processus).label_y[0] = d_code_fin_chaine;
  225:     (*s_etat_processus).label_z[0] = d_code_fin_chaine;
  226:     (*s_etat_processus).legende[0] = d_code_fin_chaine;
  227: 
  228:     marque = (*s_etat_processus).s_marques;
  229: 
  230:     while(marque != NULL)
  231:     {
  232:         free((*marque).position);
  233:         free((*marque).label);
  234:         prochaine_marque = (*marque).suivant;
  235:         free(marque);
  236:         marque = prochaine_marque;
  237:     }
  238: 
  239:     (*s_etat_processus).s_marques = NULL;
  240: 
  241:     return;
  242: }
  243: 
  244: 
  245: /*
  246: ================================================================================
  247:   Fonction 'cf'
  248: ================================================================================
  249:   Entrées : structure processus
  250: --------------------------------------------------------------------------------
  251:   Sorties :
  252: --------------------------------------------------------------------------------
  253:   Effets de bord : néant
  254: ================================================================================
  255: */
  256: 
  257: void
  258: instruction_cf(struct_processus *s_etat_processus)
  259: {
  260:     struct_objet                            *s_objet;
  261: 
  262:     (*s_etat_processus).erreur_execution = d_ex;
  263: 
  264:     if ((*s_etat_processus).affichage_arguments == 'Y')
  265:     {
  266:         printf("\n  CF ");
  267: 
  268:         if ((*s_etat_processus).langue == 'F')
  269:         {
  270:             printf("(efface un indicateur binaire)\n\n");
  271:         }
  272:         else
  273:         {
  274:             printf("(clear flag)\n\n");
  275:         }
  276: 
  277:         printf("    1: 1 <= %s <= 64\n", d_INT);
  278: 
  279:         return;
  280:     }
  281:     else if ((*s_etat_processus).test_instruction == 'Y')
  282:     {
  283:         (*s_etat_processus).nombre_arguments = -1;
  284:         return;
  285:     }
  286: 
  287:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  288:     {
  289:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  290:         {
  291:             return;
  292:         }
  293:     }
  294: 
  295:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  296:             &s_objet) == d_erreur)
  297:     {
  298:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  299:         return;
  300:     }
  301: 
  302:     if ((*s_objet).type == INT)
  303:     {
  304:         if (((*((integer8 *) (*s_objet).objet)) < 1) || ((*((integer8 *)
  305:                 (*s_objet).objet)) > 64))
  306:         {
  307:             liberation(s_etat_processus, s_objet);
  308: 
  309:             (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
  310:             return;
  311:         }
  312: 
  313:         cf(s_etat_processus, (unsigned char) (*((integer8 *)
  314:                 (*s_objet).objet)));
  315:     }
  316:     else
  317:     {
  318:         liberation(s_etat_processus, s_objet);
  319: 
  320:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  321:         return;
  322:     }
  323: 
  324:     liberation(s_etat_processus, s_objet);
  325: 
  326:     return;
  327: }
  328: 
  329: 
  330: /*
  331: ================================================================================
  332:   Fonction 'ceil'
  333: ================================================================================
  334:   Entrées :
  335: --------------------------------------------------------------------------------
  336:   Sorties :
  337: --------------------------------------------------------------------------------
  338:   Effets de bord : néant
  339: ================================================================================
  340: */
  341: 
  342: void
  343: instruction_ceil(struct_processus *s_etat_processus)
  344: {
  345:     struct_liste_chainee                *l_element_courant;
  346:     struct_liste_chainee                *l_element_precedent;
  347: 
  348:     struct_objet                        *s_copie_argument;
  349:     struct_objet                        *s_objet_argument;
  350:     struct_objet                        *s_objet_resultat;
  351: 
  352:     (*s_etat_processus).erreur_execution = d_ex;
  353: 
  354:     if ((*s_etat_processus).affichage_arguments == 'Y')
  355:     {
  356:         printf("\n  CEIL ");
  357: 
  358:         if ((*s_etat_processus).langue == 'F')
  359:         {
  360:             printf("(entier supérieur)\n\n");
  361:         }
  362:         else
  363:         {
  364:             printf("(ceil)\n\n");
  365:         }
  366: 
  367:         printf("    1: %s\n", d_INT);
  368:         printf("->  1: %s\n\n", d_INT);
  369: 
  370:         printf("    1: %s\n", d_REL);
  371:         printf("->  1: %s\n\n", d_REL);
  372: 
  373:         printf("    1: %s, %s\n", d_NOM, d_ALG);
  374:         printf("->  1: %s\n\n", d_ALG);
  375: 
  376:         printf("    1: %s\n", d_RPN);
  377:         printf("->  1: %s\n", d_RPN);
  378: 
  379:         return;
  380:     }
  381:     else if ((*s_etat_processus).test_instruction == 'Y')
  382:     {
  383:         (*s_etat_processus).nombre_arguments = 1;
  384:         return;
  385:     }
  386: 
  387:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  388:     {
  389:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  390:         {
  391:             return;
  392:         }
  393:     }
  394: 
  395:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  396:             &s_objet_argument) == d_erreur)
  397:     {
  398:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  399:         return;
  400:     }
  401: 
  402: /*
  403: --------------------------------------------------------------------------------
  404:   Plafond d'un entier
  405: --------------------------------------------------------------------------------
  406: */
  407: 
  408:     if ((*s_objet_argument).type == INT)
  409:     {
  410:         s_objet_resultat = s_objet_argument;
  411:         s_objet_argument = NULL;
  412:     }
  413: 
  414: /*
  415: --------------------------------------------------------------------------------
  416:   Plafond d'un réel
  417: --------------------------------------------------------------------------------
  418: */
  419: 
  420:     else if ((*s_objet_argument).type == REL)
  421:     {
  422:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
  423:         {
  424:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  425:             return;
  426:         }
  427: 
  428:         (*((integer8 *) (*s_objet_resultat).objet)) = (integer8)
  429:                 ceil((*((real8 *) (*s_objet_argument).objet)));
  430: 
  431:         if (!(((((*((integer8 *) (*s_objet_resultat).objet)) - 1) <
  432:                 (*((real8 *) (*s_objet_argument).objet))) && ((*((integer8 *)
  433:                 (*s_objet_resultat).objet)) > (*((real8 *) (*s_objet_argument)
  434:                 .objet))))))
  435:         {
  436:             free((*s_objet_resultat).objet);
  437: 
  438:             if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
  439:             {
  440:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  441:                 return;
  442:             }
  443: 
  444:             (*s_objet_resultat).type = REL;
  445:             (*((real8 *) (*s_objet_resultat).objet)) =
  446:                     ceil((*((real8 *) (*s_objet_argument).objet)));
  447:         }
  448:     }
  449: 
  450: /*
  451: --------------------------------------------------------------------------------
  452:   Plafond d'un nom
  453: --------------------------------------------------------------------------------
  454: */
  455: 
  456:     else if ((*s_objet_argument).type == NOM)
  457:     {
  458:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
  459:         {
  460:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  461:             return;
  462:         }
  463: 
  464:         if (((*s_objet_resultat).objet =
  465:                 allocation_maillon(s_etat_processus)) == NULL)
  466:         {
  467:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  468:             return;
  469:         }
  470: 
  471:         l_element_courant = (*s_objet_resultat).objet;
  472: 
  473:         if (((*l_element_courant).donnee =
  474:                 allocation(s_etat_processus, FCT)) == NULL)
  475:         {
  476:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  477:             return;
  478:         }
  479: 
  480:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  481:                 .nombre_arguments = 0;
  482:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  483:                 .fonction = instruction_vers_niveau_superieur;
  484: 
  485:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  486:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  487:         {
  488:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  489:             return;
  490:         }
  491: 
  492:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  493:                 .nom_fonction, "<<");
  494: 
  495:         if (((*l_element_courant).suivant =
  496:                 allocation_maillon(s_etat_processus)) == NULL)
  497:         {
  498:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  499:             return;
  500:         }
  501: 
  502:         l_element_courant = (*l_element_courant).suivant;
  503:         (*l_element_courant).donnee = s_objet_argument;
  504: 
  505:         if (((*l_element_courant).suivant =
  506:                 allocation_maillon(s_etat_processus)) == NULL)
  507:         {
  508:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  509:             return;
  510:         }
  511: 
  512:         l_element_courant = (*l_element_courant).suivant;
  513: 
  514:         if (((*l_element_courant).donnee =
  515:                 allocation(s_etat_processus, FCT)) == NULL)
  516:         {
  517:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  518:             return;
  519:         }
  520: 
  521:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  522:                 .nombre_arguments = 1;
  523:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  524:                 .fonction = instruction_ceil;
  525: 
  526:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  527:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
  528:         {
  529:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  530:             return;
  531:         }
  532: 
  533:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  534:                 .nom_fonction, "CEIL");
  535: 
  536:         if (((*l_element_courant).suivant =
  537:                 allocation_maillon(s_etat_processus)) == NULL)
  538:         {
  539:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  540:             return;
  541:         }
  542: 
  543:         l_element_courant = (*l_element_courant).suivant;
  544: 
  545:         if (((*l_element_courant).donnee =
  546:                 allocation(s_etat_processus, FCT)) == NULL)
  547:         {
  548:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  549:             return;
  550:         }
  551: 
  552:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  553:                 .nombre_arguments = 0;
  554:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  555:                 .fonction = instruction_vers_niveau_inferieur;
  556: 
  557:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  558:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  559:         {
  560:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  561:             return;
  562:         }
  563: 
  564:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  565:                 .nom_fonction, ">>");
  566: 
  567:         (*l_element_courant).suivant = NULL;
  568:         s_objet_argument = NULL;
  569:     }
  570: 
  571: /*
  572: --------------------------------------------------------------------------------
  573:   Plafond d'une expression
  574: --------------------------------------------------------------------------------
  575: */
  576: 
  577:     else if (((*s_objet_argument).type == ALG) ||
  578:             ((*s_objet_argument).type == RPN))
  579:     {
  580:         if ((s_copie_argument = copie_objet(s_etat_processus,
  581:                 s_objet_argument, 'N')) == NULL)
  582:         {
  583:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  584:             return;
  585:         }
  586: 
  587:         l_element_courant = (struct_liste_chainee *)
  588:                 (*s_copie_argument).objet;
  589:         l_element_precedent = l_element_courant;
  590: 
  591:         while((*l_element_courant).suivant != NULL)
  592:         {
  593:             l_element_precedent = l_element_courant;
  594:             l_element_courant = (*l_element_courant).suivant;
  595:         }
  596: 
  597:         if (((*l_element_precedent).suivant =
  598:                 allocation_maillon(s_etat_processus)) == NULL)
  599:         {
  600:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  601:             return;
  602:         }
  603: 
  604:         if (((*(*l_element_precedent).suivant).donnee =
  605:                 allocation(s_etat_processus, FCT)) == NULL)
  606:         {
  607:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  608:             return;
  609:         }
  610: 
  611:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  612:                 .donnee).objet)).nombre_arguments = 1;
  613:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  614:                 .donnee).objet)).fonction = instruction_ceil;
  615: 
  616:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
  617:                 .suivant).donnee).objet)).nom_fonction =
  618:                 malloc(5 * sizeof(unsigned char))) == NULL)
  619:         {
  620:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  621:             return;
  622:         }
  623: 
  624:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
  625:                 .suivant).donnee).objet)).nom_fonction, "CEIL");
  626: 
  627:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  628: 
  629:         s_objet_resultat = s_copie_argument;
  630:     }
  631: 
  632: /*
  633: --------------------------------------------------------------------------------
  634:   Fonction ceil impossible à réaliser
  635: --------------------------------------------------------------------------------
  636: */
  637: 
  638:     else
  639:     {
  640:         liberation(s_etat_processus, s_objet_argument);
  641: 
  642:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  643:         return;
  644:     }
  645: 
  646:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  647:             s_objet_resultat) == d_erreur)
  648:     {
  649:         return;
  650:     }
  651: 
  652:     liberation(s_etat_processus, s_objet_argument);
  653: 
  654:     return;
  655: }
  656: 
  657: 
  658: /*
  659: ================================================================================
  660:   Fonction 'case'
  661: ================================================================================
  662:   Entrées :
  663: --------------------------------------------------------------------------------
  664:   Sorties :
  665: --------------------------------------------------------------------------------
  666:   Effets de bord : néant
  667: ================================================================================
  668: */
  669: 
  670: void
  671: instruction_case(struct_processus *s_etat_processus)
  672: {
  673:     struct_liste_pile_systeme   *l_element_courant;
  674: 
  675:     struct_objet                *s_objet;
  676: 
  677:     (*s_etat_processus).erreur_execution = d_ex;
  678: 
  679:     if ((*s_etat_processus).affichage_arguments == 'Y')
  680:     {
  681:         printf("\n  CASE ");
  682: 
  683:         if ((*s_etat_processus).langue == 'F')
  684:         {
  685:             printf("(structure de contrôle)\n\n");
  686:             printf("  Utilisation :\n\n");
  687:         }
  688:         else
  689:         {
  690:             printf("(control statement)\n\n");
  691:             printf("  Usage:\n\n");
  692:         }
  693: 
  694:         printf("    SELECT (expression test)\n");
  695:         printf("        CASE (clause 1) THEN (expression 1) END\n");
  696:         printf("        CASE (clause 2) THEN (expression 2) END\n");
  697:         printf("        ...\n");
  698:         printf("        CASE (clause n) THEN (expression n) END\n");
  699:         printf("    DEFAULT\n");
  700:         printf("        (expression)\n");
  701:         printf("    END\n\n");
  702: 
  703:         printf("    SELECT (expression test)\n");
  704:         printf("        CASE (clause 1) THEN (expression 1) END\n");
  705:         printf("        (expression)\n");
  706:         printf("        CASE (clause 2) THEN (expression 2) END\n");
  707:         printf("    END\n");
  708: 
  709:         return;
  710:     }
  711:     else if ((*s_etat_processus).test_instruction == 'Y')
  712:     {
  713:         (*s_etat_processus).nombre_arguments = -1;
  714:         return;
  715:     }
  716: 
  717:     l_element_courant = (*s_etat_processus).l_base_pile_systeme;
  718: 
  719:     while(l_element_courant != NULL)
  720:     {
  721:         if (((*l_element_courant).clause == 'S') ||
  722:             ((*l_element_courant).clause == 'C') ||
  723:             ((*l_element_courant).clause == 'K'))
  724:         {
  725:             break;
  726:         }
  727: 
  728:         l_element_courant = (*l_element_courant).suivant;
  729:     }
  730: 
  731:     if (l_element_courant == NULL)
  732:     {
  733:         (*s_etat_processus).erreur_systeme = d_es_pile_vide;
  734:         return;
  735:     }
  736: 
  737:     if ((*l_element_courant).clause == 'S')
  738:     {
  739:         /*
  740:          * Première apparition de l'instruction CASE dans la structure de test.
  741:          */
  742: 
  743:         if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  744:                 &s_objet) == d_erreur)
  745:         {
  746:             (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  747:             return;
  748:         }
  749: 
  750:         (*l_element_courant).objet_de_test = s_objet;
  751:         (*l_element_courant).clause = 'K';
  752:     }
  753: 
  754:     if ((s_objet = copie_objet(s_etat_processus,
  755:             (*l_element_courant).objet_de_test, 'P')) == NULL)
  756:     {
  757:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  758:         return;
  759:     }
  760: 
  761:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  762:             s_objet) == d_erreur)
  763:     {
  764:         return;
  765:     }
  766: 
  767:     /*
  768:      * Empilement sur la pile système ne servant qu'à la bonne exécution
  769:      * des reprises sur erreur
  770:      */
  771: 
  772:     empilement_pile_systeme(s_etat_processus);
  773: 
  774:     if ((*s_etat_processus).erreur_systeme != d_es)
  775:     {
  776:         return;
  777:     }
  778: 
  779:     (*(*s_etat_processus).l_base_pile_systeme).clause =
  780:             (*l_element_courant).clause;
  781:     (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'K';
  782:     return;
  783: }
  784: 
  785: 
  786: /*
  787: ================================================================================
  788:   Fonction 'c->r'
  789: ================================================================================
  790:   Entrées : structure processus
  791: --------------------------------------------------------------------------------
  792:   Sorties :
  793: --------------------------------------------------------------------------------
  794:   Effets de bord : néant
  795: ================================================================================
  796: */
  797: 
  798: void
  799: instruction_c_vers_r(struct_processus *s_etat_processus)
  800: {
  801:     struct_objet                    *s_objet_argument;
  802:     struct_objet                    *s_objet_resultat_1;
  803:     struct_objet                    *s_objet_resultat_2;
  804: 
  805:     integer8                        i;
  806:     integer8                        j;
  807: 
  808:     (*s_etat_processus).erreur_execution = d_ex;
  809: 
  810:     if ((*s_etat_processus).affichage_arguments == 'Y')
  811:     {
  812:         printf("\n  C->R ");
  813: 
  814:         if ((*s_etat_processus).langue == 'F')
  815:         {
  816:             printf("(complexe vers réel)\n\n");
  817:         }
  818:         else
  819:         {
  820:             printf("(complex to real)\n\n");
  821:         }
  822: 
  823:         printf("    1: %s\n", d_CPL);
  824:         printf("->  2: %s\n", d_REL);
  825:         printf("    1: %s\n\n", d_REL);
  826: 
  827:         printf("    1: %s\n", d_VCX);
  828:         printf("->  2: %s\n", d_VRL);
  829:         printf("    1: %s\n\n", d_VRL);
  830: 
  831:         printf("    1: %s\n", d_MCX);
  832:         printf("->  2: %s\n", d_MRL);
  833:         printf("    1: %s\n", d_MRL);
  834: 
  835:         return;
  836:     }
  837:     else if ((*s_etat_processus).test_instruction == 'Y')
  838:     {
  839:         (*s_etat_processus).nombre_arguments = -1;
  840:         return;
  841:     }
  842: 
  843:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  844:     {
  845:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  846:         {
  847:             return;
  848:         }
  849:     }
  850: 
  851:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  852:             &s_objet_argument) == d_erreur)
  853:     {
  854:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  855:         return;
  856:     }
  857: 
  858: /*
  859: --------------------------------------------------------------------------------
  860:   Eclatement d'un complexe
  861: --------------------------------------------------------------------------------
  862: */
  863: 
  864:     if ((*s_objet_argument).type == CPL)
  865:     {
  866:         if ((s_objet_resultat_1 = allocation(s_etat_processus, REL))
  867:                 == NULL)
  868:         {
  869:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  870:             return;
  871:         }
  872: 
  873:         if ((s_objet_resultat_2 = allocation(s_etat_processus, REL))
  874:                 == NULL)
  875:         {
  876:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  877:             return;
  878:         }
  879: 
  880:         (*((real8 *) (*s_objet_resultat_1).objet)) =
  881:                 (*((struct_complexe16 *) (*s_objet_argument).objet))
  882:                 .partie_imaginaire;
  883: 
  884:         (*((real8 *) (*s_objet_resultat_2).objet)) =
  885:                 (*((struct_complexe16 *) (*s_objet_argument).objet))
  886:                 .partie_reelle;
  887:     }
  888: 
  889: /*
  890: --------------------------------------------------------------------------------
  891:   Eclatement d'un vecteur
  892: --------------------------------------------------------------------------------
  893: */
  894: 
  895:     else if ((*s_objet_argument).type == VCX)
  896:     {
  897:         if ((s_objet_resultat_1 = allocation(s_etat_processus, VRL))
  898:                 == NULL)
  899:         {
  900:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  901:             return;
  902:         }
  903: 
  904:         if ((s_objet_resultat_2 = allocation(s_etat_processus, VRL))
  905:                 == NULL)
  906:         {
  907:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  908:             return;
  909:         }
  910: 
  911:         if (((*((struct_vecteur *) (*s_objet_resultat_1).objet)).tableau =
  912:                 malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument)
  913:                 .objet))).taille) * sizeof(real8))) == NULL)
  914:         {
  915:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  916:             return;
  917:         }
  918: 
  919:         if (((*((struct_vecteur *) (*s_objet_resultat_2).objet)).tableau =
  920:                 malloc(((size_t) (*(((struct_vecteur *) (*s_objet_argument)
  921:                 .objet))).taille) * sizeof(real8))) == NULL)
  922:         {
  923:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  924:             return;
  925:         }
  926: 
  927:         (*((struct_vecteur *) (*s_objet_resultat_1).objet)).taille =
  928:                 (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
  929:         (*((struct_vecteur *) (*s_objet_resultat_2).objet)).taille =
  930:                 (*(((struct_vecteur *) (*s_objet_argument).objet))).taille;
  931: 
  932:         for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
  933:                 .taille; i++)
  934:         {
  935:             ((real8 *) (*((struct_vecteur *) (*s_objet_resultat_1).objet))
  936:                     .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
  937:                     (*s_objet_argument).objet)).tableau)[i].partie_imaginaire;
  938: 
  939:             ((real8 *) (*((struct_vecteur *) (*s_objet_resultat_2).objet))
  940:                     .tableau)[i] = ((struct_complexe16 *) (*((struct_vecteur *)
  941:                     (*s_objet_argument).objet)).tableau)[i].partie_reelle;
  942:         }
  943:     }
  944: 
  945: /*
  946: --------------------------------------------------------------------------------
  947:   Eclatement d'une matrice
  948: --------------------------------------------------------------------------------
  949: */
  950: 
  951:     else if ((*s_objet_argument).type == MCX)
  952:     {
  953:         if ((s_objet_resultat_1 = allocation(s_etat_processus, MRL))
  954:                 == NULL)
  955:         {
  956:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  957:             return;
  958:         }
  959: 
  960:         if ((s_objet_resultat_2 = allocation(s_etat_processus, MRL))
  961:                 == NULL)
  962:         {
  963:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  964:             return;
  965:         }
  966: 
  967:         if (((*((struct_matrice *) (*s_objet_resultat_1).objet)).tableau =
  968:                 malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument)
  969:                 .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
  970:         {
  971:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  972:             return;
  973:         }
  974: 
  975:         if (((*((struct_matrice *) (*s_objet_resultat_2).objet)).tableau =
  976:                 malloc(((size_t) (*(((struct_matrice *) (*s_objet_argument)
  977:                 .objet))).nombre_lignes) * sizeof(real8 *))) == NULL)
  978:         {
  979:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  980:             return;
  981:         }
  982: 
  983:         (*((struct_matrice *) (*s_objet_resultat_1).objet)).nombre_lignes =
  984:                 (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
  985:         (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_lignes =
  986:                 (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
  987:         (*((struct_matrice *) (*s_objet_resultat_1).objet)).nombre_colonnes =
  988:                 (*((struct_matrice *) (*s_objet_argument).objet))
  989:                 .nombre_colonnes;
  990:         (*((struct_matrice *) (*s_objet_resultat_2).objet)).nombre_colonnes =
  991:                 (*((struct_matrice *) (*s_objet_argument).objet))
  992:                 .nombre_colonnes;
  993: 
  994:         for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
  995:                 .nombre_lignes; i++)
  996:         {
  997:             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_1)
  998:                     .objet)).tableau)[i] = malloc(((size_t)
  999:                     (*(((struct_matrice *) (*s_objet_argument).objet)))
 1000:                     .nombre_colonnes) * sizeof(real8))) == NULL)
 1001:             {
 1002:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1003:                 return;
 1004:             }
 1005: 
 1006:             if ((((real8 **) (*((struct_matrice *) (*s_objet_resultat_2)
 1007:                     .objet)).tableau)[i] = malloc(((size_t)
 1008:                     (*(((struct_matrice *) (*s_objet_argument).objet)))
 1009:                     .nombre_colonnes) * sizeof(real8))) == NULL)
 1010:             {
 1011:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1012:                 return;
 1013:             }
 1014: 
 1015:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
 1016:                     .nombre_colonnes; j++)
 1017:             {
 1018:                 ((real8 **) (*((struct_matrice *) (*s_objet_resultat_1).objet))
 1019:                         .tableau)[i][j] = ((struct_complexe16 **)
 1020:                         (*((struct_matrice *) (*s_objet_argument).objet))
 1021:                         .tableau)[i][j].partie_imaginaire;
 1022: 
 1023:                 ((real8 **) (*((struct_matrice *) (*s_objet_resultat_2).objet))
 1024:                         .tableau)[i][j] = ((struct_complexe16 **)
 1025:                         (*((struct_matrice *) (*s_objet_argument).objet))
 1026:                         .tableau)[i][j].partie_reelle;
 1027:             }
 1028:         }
 1029:     }
 1030: 
 1031: /*
 1032: --------------------------------------------------------------------------------
 1033:   Eclatement impossible
 1034: --------------------------------------------------------------------------------
 1035: */
 1036: 
 1037:     else
 1038:     {
 1039:         liberation(s_etat_processus, s_objet_argument);
 1040: 
 1041:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1042:         return;
 1043:     }
 1044: 
 1045:     liberation(s_etat_processus, s_objet_argument);
 1046: 
 1047:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1048:             s_objet_resultat_2) == d_erreur)
 1049:     {
 1050:         return;
 1051:     }
 1052: 
 1053:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1054:             s_objet_resultat_1) == d_erreur)
 1055:     {
 1056:         return;
 1057:     }
 1058: 
 1059:     return;
 1060: }
 1061: 
 1062: 
 1063: /*
 1064: ================================================================================
 1065:   Fonction 'conj'
 1066: ================================================================================
 1067:   Entrées :
 1068: --------------------------------------------------------------------------------
 1069:   Sorties :
 1070: --------------------------------------------------------------------------------
 1071:   Effets de bord : néant
 1072: ================================================================================
 1073: */
 1074: 
 1075: void
 1076: instruction_conj(struct_processus *s_etat_processus)
 1077: {
 1078:     struct_liste_chainee        *l_element_courant;
 1079:     struct_liste_chainee        *l_element_precedent;
 1080: 
 1081:     struct_objet                *s_copie_argument;
 1082:     struct_objet                *s_objet_argument;
 1083:     struct_objet                *s_objet_resultat;
 1084: 
 1085:     integer8                    i;
 1086:     integer8                    j;
 1087: 
 1088:     (*s_etat_processus).erreur_execution = d_ex;
 1089: 
 1090:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1091:     {
 1092:         printf("\n  CONJ ");
 1093: 
 1094:         if ((*s_etat_processus).langue == 'F')
 1095:         {
 1096:             printf("(conjugaison)\n\n");
 1097:         }
 1098:         else
 1099:         {
 1100:             printf("(conjugated)\n\n");
 1101:         }
 1102: 
 1103:         printf("    1: %s\n", d_INT);
 1104:         printf("->  1: %s\n\n", d_INT);
 1105: 
 1106:         printf("    1: %s\n", d_REL);
 1107:         printf("->  1: %s\n\n", d_REL);
 1108: 
 1109:         printf("    1: %s\n", d_CPL);
 1110:         printf("->  1: %s\n\n", d_CPL);
 1111: 
 1112:         printf("    1: %s\n", d_VIN);
 1113:         printf("->  1: %s\n\n", d_VIN);
 1114: 
 1115:         printf("    1: %s\n", d_VRL);
 1116:         printf("->  1: %s\n\n", d_VRL);
 1117: 
 1118:         printf("    1: %s\n", d_VCX);
 1119:         printf("->  1: %s\n\n", d_VCX);
 1120: 
 1121:         printf("    1: %s\n", d_MIN);
 1122:         printf("->  1: %s\n\n", d_MIN);
 1123: 
 1124:         printf("    1: %s\n", d_MRL);
 1125:         printf("->  1: %s\n\n", d_MRL);
 1126: 
 1127:         printf("    1: %s\n", d_MCX);
 1128:         printf("->  1: %s\n\n", d_MCX);
 1129: 
 1130:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1131:         printf("->  1: %s\n\n", d_ALG);
 1132: 
 1133:         printf("    1: %s\n", d_RPN);
 1134:         printf("->  1: %s\n", d_RPN);
 1135: 
 1136:         return;
 1137:     }
 1138:     else if ((*s_etat_processus).test_instruction == 'Y')
 1139:     {
 1140:         (*s_etat_processus).nombre_arguments = 1;
 1141:         return;
 1142:     }
 1143: 
 1144:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1145:     {
 1146:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1147:         {
 1148:             return;
 1149:         }
 1150:     }
 1151: 
 1152:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1153:             &s_objet_argument) == d_erreur)
 1154:     {
 1155:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1156:         return;
 1157:     }
 1158: 
 1159: /*
 1160: --------------------------------------------------------------------------------
 1161:   Conjugué d'un entier ou d'un réel
 1162: --------------------------------------------------------------------------------
 1163: */
 1164: 
 1165:     if (((*s_objet_argument).type == INT) ||
 1166:             ((*s_objet_argument).type == REL))
 1167:     {
 1168:         s_objet_resultat = s_objet_argument;
 1169:         s_objet_argument = NULL;
 1170:     }
 1171: 
 1172: /*
 1173: --------------------------------------------------------------------------------
 1174:   Conjugué d'un complexe
 1175: --------------------------------------------------------------------------------
 1176: */
 1177: 
 1178:     else if ((*s_objet_argument).type == CPL)
 1179:     {
 1180:         (*((struct_complexe16 *) (*s_objet_argument).objet)).partie_reelle =
 1181:                 (*((struct_complexe16 *) (*s_objet_argument).objet))
 1182:                 .partie_reelle;
 1183:         (*((struct_complexe16 *) (*s_objet_argument).objet)).partie_imaginaire =
 1184:                 -(*((struct_complexe16 *) (*s_objet_argument).objet))
 1185:                 .partie_imaginaire;
 1186: 
 1187:         s_objet_resultat = s_objet_argument;
 1188:         s_objet_argument = NULL;
 1189:     }
 1190: 
 1191: /*
 1192: --------------------------------------------------------------------------------
 1193:   Conjugué d'un vecteur d'entiers ou de réels
 1194: --------------------------------------------------------------------------------
 1195: */
 1196: 
 1197:     else if (((*s_objet_argument).type == VIN) ||
 1198:             ((*s_objet_argument).type == VRL))
 1199:     {
 1200:         s_objet_resultat = s_objet_argument;
 1201:         s_objet_argument = NULL;
 1202:     }
 1203: 
 1204: /*
 1205: --------------------------------------------------------------------------------
 1206:   Conjugué d'un vecteur de complexes
 1207: --------------------------------------------------------------------------------
 1208: */
 1209: 
 1210:     else if ((*s_objet_argument).type == VCX)
 1211:     {
 1212:         for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
 1213:                 .taille; i++)
 1214:         {
 1215:             ((struct_complexe16 *) (*(((struct_vecteur *) (*s_objet_argument)
 1216:                     .objet))).tableau)[i].partie_reelle =
 1217:                     ((struct_complexe16 *) (*(((struct_vecteur *)
 1218:                     (*s_objet_argument).objet))).tableau)[i].partie_reelle;
 1219:             ((struct_complexe16 *) (*(((struct_vecteur *) (*s_objet_argument)
 1220:                     .objet))).tableau)[i].partie_imaginaire =
 1221:                     -((struct_complexe16 *) (*(((struct_vecteur *)
 1222:                     (*s_objet_argument).objet))).tableau)[i].partie_imaginaire;
 1223:         }
 1224: 
 1225:         s_objet_resultat = s_objet_argument;
 1226:         s_objet_argument = NULL;
 1227:     }
 1228: 
 1229: /*
 1230: --------------------------------------------------------------------------------
 1231:   Conjuguée d'une matrice d'entiers ou de réels
 1232: --------------------------------------------------------------------------------
 1233: */
 1234: 
 1235:     else if (((*s_objet_argument).type == MIN) ||
 1236:             ((*s_objet_argument).type == MRL))
 1237:     {
 1238:         s_objet_resultat = s_objet_argument;
 1239:         s_objet_argument = NULL;
 1240:     }
 1241: 
 1242: /*
 1243: --------------------------------------------------------------------------------
 1244:   Conjuguée d'une matrice de complexes
 1245: --------------------------------------------------------------------------------
 1246: */
 1247: 
 1248:     else if ((*s_objet_argument).type == MCX)
 1249:     {
 1250:         for(i = 0; i < (*(((struct_matrice *) (*s_objet_argument).objet)))
 1251:                 .nombre_lignes; i++)
 1252:         {
 1253:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
 1254:                     .nombre_colonnes; j++)
 1255:             {
 1256:                 ((struct_complexe16 **) (*(((struct_matrice *)
 1257:                         (*s_objet_argument).objet))).tableau)[i][j]
 1258:                         .partie_reelle = ((struct_complexe16 **)
 1259:                         (*(((struct_matrice *) (*s_objet_argument).objet)))
 1260:                         .tableau)[i][j].partie_reelle;
 1261:                 ((struct_complexe16 **) (*(((struct_matrice *)
 1262:                         (*s_objet_argument).objet))).tableau)[i][j]
 1263:                         .partie_imaginaire = -((struct_complexe16 **)
 1264:                         (*(((struct_matrice *) (*s_objet_argument).objet)))
 1265:                         .tableau)[i][j].partie_imaginaire;
 1266:             }
 1267:         }
 1268: 
 1269:         s_objet_resultat = s_objet_argument;
 1270:         s_objet_argument = NULL;
 1271:     }
 1272: 
 1273: /*
 1274: --------------------------------------------------------------------------------
 1275:   Conjugué d'un nom
 1276: --------------------------------------------------------------------------------
 1277: */
 1278: 
 1279:     else if ((*s_objet_argument).type == NOM)
 1280:     {
 1281:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
 1282:                 == NULL)
 1283:         {
 1284:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1285:             return;
 1286:         }
 1287: 
 1288:         if (((*s_objet_resultat).objet =
 1289:                 allocation_maillon(s_etat_processus)) == NULL)
 1290:         {
 1291:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1292:             return;
 1293:         }
 1294: 
 1295:         l_element_courant = (*s_objet_resultat).objet;
 1296: 
 1297:         if (((*l_element_courant).donnee =
 1298:                 allocation(s_etat_processus, FCT)) == NULL)
 1299:         {
 1300:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1301:             return;
 1302:         }
 1303: 
 1304:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1305:                 .nombre_arguments = 0;
 1306:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1307:                 .fonction = instruction_vers_niveau_superieur;
 1308: 
 1309:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1310:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1311:         {
 1312:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1313:             return;
 1314:         }
 1315: 
 1316:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1317:                 .nom_fonction, "<<");
 1318: 
 1319:         if (((*l_element_courant).suivant =
 1320:                 allocation_maillon(s_etat_processus)) == NULL)
 1321:         {
 1322:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1323:             return;
 1324:         }
 1325: 
 1326:         l_element_courant = (*l_element_courant).suivant;
 1327:         (*l_element_courant).donnee = s_objet_argument;
 1328: 
 1329:         if (((*l_element_courant).suivant =
 1330:                 allocation_maillon(s_etat_processus)) == NULL)
 1331:         {
 1332:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1333:             return;
 1334:         }
 1335: 
 1336:         l_element_courant = (*l_element_courant).suivant;
 1337: 
 1338:         if (((*l_element_courant).donnee =
 1339:                 allocation(s_etat_processus, FCT)) == NULL)
 1340:         {
 1341:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1342:             return;
 1343:         }
 1344: 
 1345:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1346:                 .nombre_arguments = 1;
 1347:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1348:                 .fonction = instruction_conj;
 1349: 
 1350:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1351:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 1352:         {
 1353:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1354:             return;
 1355:         }
 1356: 
 1357:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1358:                 .nom_fonction, "CONJ");
 1359: 
 1360:         if (((*l_element_courant).suivant =
 1361:                 allocation_maillon(s_etat_processus)) == NULL)
 1362:         {
 1363:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1364:             return;
 1365:         }
 1366: 
 1367:         l_element_courant = (*l_element_courant).suivant;
 1368: 
 1369:         if (((*l_element_courant).donnee =
 1370:                 allocation(s_etat_processus, FCT)) == NULL)
 1371:         {
 1372:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1373:             return;
 1374:         }
 1375: 
 1376:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1377:                 .nombre_arguments = 0;
 1378:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1379:                 .fonction = instruction_vers_niveau_inferieur;
 1380: 
 1381:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1382:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1383:         {
 1384:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1385:             return;
 1386:         }
 1387: 
 1388:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1389:                 .nom_fonction, ">>");
 1390: 
 1391:         (*l_element_courant).suivant = NULL;
 1392:         s_objet_argument = NULL;
 1393:     }
 1394: 
 1395: /*
 1396: --------------------------------------------------------------------------------
 1397:   Conjuguée d'une expression
 1398: --------------------------------------------------------------------------------
 1399: */
 1400: 
 1401:     else if (((*s_objet_argument).type == ALG) ||
 1402:             ((*s_objet_argument).type == RPN))
 1403:     {
 1404:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1405:                 s_objet_argument, 'N')) == NULL)
 1406:         {
 1407:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1408:             return;
 1409:         }
 1410: 
 1411:         l_element_courant = (struct_liste_chainee *)
 1412:                 (*s_copie_argument).objet;
 1413:         l_element_precedent = l_element_courant;
 1414: 
 1415:         while((*l_element_courant).suivant != NULL)
 1416:         {
 1417:             l_element_precedent = l_element_courant;
 1418:             l_element_courant = (*l_element_courant).suivant;
 1419:         }
 1420: 
 1421:         if (((*l_element_precedent).suivant =
 1422:                 allocation_maillon(s_etat_processus)) == NULL)
 1423:         {
 1424:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1425:             return;
 1426:         }
 1427: 
 1428:         if (((*(*l_element_precedent).suivant).donnee =
 1429:                 allocation(s_etat_processus, FCT)) == NULL)
 1430:         {
 1431:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1432:             return;
 1433:         }
 1434: 
 1435:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1436:                 .donnee).objet)).nombre_arguments = 1;
 1437:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1438:                 .donnee).objet)).fonction = instruction_conj;
 1439: 
 1440:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1441:                 .suivant).donnee).objet)).nom_fonction =
 1442:                 malloc(5 * sizeof(unsigned char))) == NULL)
 1443:         {
 1444:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1445:             return;
 1446:         }
 1447: 
 1448:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1449:                 .suivant).donnee).objet)).nom_fonction, "CONJ");
 1450: 
 1451:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1452: 
 1453:         s_objet_resultat = s_copie_argument;
 1454:     }
 1455: 
 1456: /*
 1457: --------------------------------------------------------------------------------
 1458:   Conjugaison impossible
 1459: --------------------------------------------------------------------------------
 1460: */
 1461: 
 1462:     else
 1463:     {
 1464:         liberation(s_etat_processus, s_objet_argument);
 1465: 
 1466:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1467:         return;
 1468:     }
 1469: 
 1470:     liberation(s_etat_processus, s_objet_argument);
 1471: 
 1472:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1473:             s_objet_resultat) == d_erreur)
 1474:     {
 1475:         return;
 1476:     }
 1477: 
 1478:     return;
 1479: }
 1480: 
 1481: 
 1482: /*
 1483: ================================================================================
 1484:   Fonction 'cos'
 1485: ================================================================================
 1486:   Entrées : pointeur sur une structure struct_processus
 1487: --------------------------------------------------------------------------------
 1488:   Sorties :
 1489: --------------------------------------------------------------------------------
 1490:   Effets de bord : néant
 1491: ================================================================================
 1492: */
 1493: 
 1494: void
 1495: instruction_cos(struct_processus *s_etat_processus)
 1496: {
 1497:     real8                           angle;
 1498: 
 1499:     struct_liste_chainee            *l_element_courant;
 1500:     struct_liste_chainee            *l_element_precedent;
 1501: 
 1502:     struct_objet                    *s_copie_argument;
 1503:     struct_objet                    *s_objet_argument;
 1504:     struct_objet                    *s_objet_resultat;
 1505: 
 1506:     (*s_etat_processus).erreur_execution = d_ex;
 1507: 
 1508:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1509:     {
 1510:         printf("\n  COS ");
 1511: 
 1512:         if ((*s_etat_processus).langue == 'F')
 1513:         {
 1514:             printf("(cosinus)\n\n");
 1515:         }
 1516:         else
 1517:         {
 1518:             printf("(cosine)\n\n");
 1519:         }
 1520: 
 1521:         printf("    1: %s, %s\n", d_INT, d_REL);
 1522:         printf("->  1: %s\n\n", d_REL);
 1523: 
 1524:         printf("    1: %s\n", d_CPL);
 1525:         printf("->  1: %s\n\n", d_CPL);
 1526: 
 1527:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1528:         printf("->  1: %s\n\n", d_ALG);
 1529: 
 1530:         printf("    1: %s\n", d_RPN);
 1531:         printf("->  1: %s\n", d_RPN);
 1532: 
 1533:         return;
 1534:     }
 1535:     else if ((*s_etat_processus).test_instruction == 'Y')
 1536:     {
 1537:         (*s_etat_processus).nombre_arguments = 1;
 1538:         return;
 1539:     }
 1540: 
 1541:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1542:     {
 1543:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1544:         {
 1545:             return;
 1546:         }
 1547:     }
 1548: 
 1549:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1550:             &s_objet_argument) == d_erreur)
 1551:     {
 1552:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1553:         return;
 1554:     }
 1555: 
 1556: /*
 1557: --------------------------------------------------------------------------------
 1558:   Cosinus d'un entier ou d'un réel
 1559: --------------------------------------------------------------------------------
 1560: */
 1561: 
 1562:     if (((*s_objet_argument).type == INT) ||
 1563:             ((*s_objet_argument).type == REL))
 1564:     {
 1565:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1566:                 == NULL)
 1567:         {
 1568:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1569:             return;
 1570:         }
 1571: 
 1572:         if ((*s_objet_argument).type == INT)
 1573:         {
 1574:             angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
 1575:         }
 1576:         else
 1577:         {
 1578:             angle = (*((real8 *) (*s_objet_argument).objet));
 1579:         }
 1580: 
 1581:         if (test_cfsf(s_etat_processus, 60) == d_faux)
 1582:         {
 1583:             conversion_degres_vers_radians(&angle);
 1584:         }
 1585: 
 1586:         (*((real8 *) (*s_objet_resultat).objet)) = cos(angle);
 1587:     }
 1588: 
 1589: /*
 1590: --------------------------------------------------------------------------------
 1591:   Cosinus d'un complexe
 1592: --------------------------------------------------------------------------------
 1593: */
 1594: 
 1595:     else if ((*s_objet_argument).type == CPL)
 1596:     {
 1597:         if ((s_objet_resultat = allocation(s_etat_processus, CPL))
 1598:                 == NULL)
 1599:         {
 1600:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1601:             return;
 1602:         }
 1603: 
 1604:         f77cos_((struct_complexe16 *) (*s_objet_argument).objet,
 1605:                 (struct_complexe16 *) (*s_objet_resultat).objet);
 1606:     }
 1607: 
 1608: /*
 1609: --------------------------------------------------------------------------------
 1610:   Cosinus d'un nom
 1611: --------------------------------------------------------------------------------
 1612: */
 1613: 
 1614:     else if ((*s_objet_argument).type == NOM)
 1615:     {
 1616:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
 1617:                 == NULL)
 1618:         {
 1619:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1620:             return;
 1621:         }
 1622: 
 1623:         if (((*s_objet_resultat).objet =
 1624:                 allocation_maillon(s_etat_processus)) == NULL)
 1625:         {
 1626:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1627:             return;
 1628:         }
 1629: 
 1630:         l_element_courant = (*s_objet_resultat).objet;
 1631: 
 1632:         if (((*l_element_courant).donnee =
 1633:                 allocation(s_etat_processus, FCT)) == NULL)
 1634:         {
 1635:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1636:             return;
 1637:         }
 1638: 
 1639:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1640:                 .nombre_arguments = 0;
 1641:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1642:                 .fonction = instruction_vers_niveau_superieur;
 1643: 
 1644:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1645:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1646:         {
 1647:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1648:             return;
 1649:         }
 1650: 
 1651:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1652:                 .nom_fonction, "<<");
 1653: 
 1654:         if (((*l_element_courant).suivant =
 1655:                 allocation_maillon(s_etat_processus)) == NULL)
 1656:         {
 1657:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1658:             return;
 1659:         }
 1660: 
 1661:         l_element_courant = (*l_element_courant).suivant;
 1662:         (*l_element_courant).donnee = s_objet_argument;
 1663: 
 1664:         if (((*l_element_courant).suivant =
 1665:                 allocation_maillon(s_etat_processus)) == NULL)
 1666:         {
 1667:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1668:             return;
 1669:         }
 1670: 
 1671:         l_element_courant = (*l_element_courant).suivant;
 1672: 
 1673:         if (((*l_element_courant).donnee =
 1674:                 allocation(s_etat_processus, FCT)) == NULL)
 1675:         {
 1676:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1677:             return;
 1678:         }
 1679: 
 1680:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1681:                 .nombre_arguments = 1;
 1682:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1683:                 .fonction = instruction_cos;
 1684: 
 1685:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1686:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
 1687:         {
 1688:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1689:             return;
 1690:         }
 1691: 
 1692:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1693:                 .nom_fonction, "COS");
 1694: 
 1695:         if (((*l_element_courant).suivant =
 1696:                 allocation_maillon(s_etat_processus)) == NULL)
 1697:         {
 1698:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1699:             return;
 1700:         }
 1701: 
 1702:         l_element_courant = (*l_element_courant).suivant;
 1703: 
 1704:         if (((*l_element_courant).donnee =
 1705:                 allocation(s_etat_processus, FCT)) == NULL)
 1706:         {
 1707:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1708:             return;
 1709:         }
 1710: 
 1711:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1712:                 .nombre_arguments = 0;
 1713:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1714:                 .fonction = instruction_vers_niveau_inferieur;
 1715: 
 1716:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1717:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1718:         {
 1719:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1720:             return;
 1721:         }
 1722: 
 1723:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1724:                 .nom_fonction, ">>");
 1725: 
 1726:         (*l_element_courant).suivant = NULL;
 1727:         s_objet_argument = NULL;
 1728:     }
 1729: 
 1730: /*
 1731: --------------------------------------------------------------------------------
 1732:   Cosinus d'une expression
 1733: --------------------------------------------------------------------------------
 1734: */
 1735: 
 1736:     else if (((*s_objet_argument).type == ALG) ||
 1737:             ((*s_objet_argument).type == RPN))
 1738:     {
 1739:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1740:                 s_objet_argument, 'N')) == NULL)
 1741:         {
 1742:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1743:             return;
 1744:         }
 1745: 
 1746:         l_element_courant = (struct_liste_chainee *)
 1747:                 (*s_copie_argument).objet;
 1748:         l_element_precedent = l_element_courant;
 1749: 
 1750:         while((*l_element_courant).suivant != NULL)
 1751:         {
 1752:             l_element_precedent = l_element_courant;
 1753:             l_element_courant = (*l_element_courant).suivant;
 1754:         }
 1755: 
 1756:         if (((*l_element_precedent).suivant =
 1757:                 allocation_maillon(s_etat_processus)) == NULL)
 1758:         {
 1759:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1760:             return;
 1761:         }
 1762: 
 1763:         if (((*(*l_element_precedent).suivant).donnee =
 1764:                 allocation(s_etat_processus, FCT)) == NULL)
 1765:         {
 1766:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1767:             return;
 1768:         }
 1769: 
 1770:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1771:                 .donnee).objet)).nombre_arguments = 1;
 1772:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1773:                 .donnee).objet)).fonction = instruction_cos;
 1774: 
 1775:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1776:                 .suivant).donnee).objet)).nom_fonction =
 1777:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1778:         {
 1779:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1780:             return;
 1781:         }
 1782: 
 1783:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1784:                 .suivant).donnee).objet)).nom_fonction, "COS");
 1785: 
 1786:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1787: 
 1788:         s_objet_resultat = s_copie_argument;
 1789:     }
 1790: 
 1791: /*
 1792: --------------------------------------------------------------------------------
 1793:   Réalisation impossible de la fonction cosinus
 1794: --------------------------------------------------------------------------------
 1795: */
 1796: 
 1797:     else
 1798:     {
 1799:         liberation(s_etat_processus, s_objet_argument);
 1800: 
 1801:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1802:         return;
 1803:     }
 1804: 
 1805:     liberation(s_etat_processus, s_objet_argument);
 1806: 
 1807:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1808:             s_objet_resultat) == d_erreur)
 1809:     {
 1810:         return;
 1811:     }
 1812: 
 1813:     return;
 1814: }
 1815: 
 1816: 
 1817: /*
 1818: ================================================================================
 1819:   Fonction 'cosh'
 1820: ================================================================================
 1821:   Entrées : pointeur sur une structure struct_processus
 1822: --------------------------------------------------------------------------------
 1823:   Sorties :
 1824: --------------------------------------------------------------------------------
 1825:   Effets de bord : néant
 1826: ================================================================================
 1827: */
 1828: 
 1829: void
 1830: instruction_cosh(struct_processus *s_etat_processus)
 1831: {
 1832:     real8                           argument;
 1833: 
 1834:     struct_liste_chainee            *l_element_courant;
 1835:     struct_liste_chainee            *l_element_precedent;
 1836: 
 1837:     struct_objet                    *s_copie_argument;
 1838:     struct_objet                    *s_objet_argument;
 1839:     struct_objet                    *s_objet_resultat;
 1840: 
 1841:     (*s_etat_processus).erreur_execution = d_ex;
 1842: 
 1843:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1844:     {
 1845:         printf("\n  COSH ");
 1846: 
 1847:         if ((*s_etat_processus).langue == 'F')
 1848:         {
 1849:             printf("(cosinus hyperbolique)\n\n");
 1850:         }
 1851:         else
 1852:         {
 1853:             printf("(hyperbolic cosine)\n\n");
 1854:         }
 1855: 
 1856:         printf("    1: %s, %s\n", d_INT, d_REL);
 1857:         printf("->  1: %s\n\n", d_INT);
 1858: 
 1859:         printf("    1: %s\n", d_CPL);
 1860:         printf("->  1: %s\n\n", d_CPL);
 1861: 
 1862:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1863:         printf("->  1: %s\n\n", d_ALG);
 1864: 
 1865:         printf("    1: %s\n", d_RPN);
 1866:         printf("->  1: %s\n", d_RPN);
 1867: 
 1868:         return;
 1869:     }
 1870:     else if ((*s_etat_processus).test_instruction == 'Y')
 1871:     {
 1872:         (*s_etat_processus).nombre_arguments = 1;
 1873:         return;
 1874:     }
 1875: 
 1876:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1877:     {
 1878:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1879:         {
 1880:             return;
 1881:         }
 1882:     }
 1883: 
 1884:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1885:             &s_objet_argument) == d_erreur)
 1886:     {
 1887:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1888:         return;
 1889:     }
 1890: 
 1891: /*
 1892: --------------------------------------------------------------------------------
 1893:   Cosinus hyperbolique d'un entier ou d'un réel
 1894: --------------------------------------------------------------------------------
 1895: */
 1896: 
 1897:     if (((*s_objet_argument).type == INT) ||
 1898:             ((*s_objet_argument).type == REL))
 1899:     {
 1900:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1901:                 == NULL)
 1902:         {
 1903:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1904:             return;
 1905:         }
 1906: 
 1907:         if ((*s_objet_argument).type == INT)
 1908:         {
 1909:             argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
 1910:         }
 1911:         else
 1912:         {
 1913:             argument = (*((real8 *) (*s_objet_argument).objet));
 1914:         }
 1915: 
 1916:         (*((real8 *) (*s_objet_resultat).objet)) = cosh(argument);
 1917:     }
 1918: 
 1919: /*
 1920: --------------------------------------------------------------------------------
 1921:   Cosinus hyperbolique d'un complexe
 1922: --------------------------------------------------------------------------------
 1923: */
 1924: 
 1925:     else if ((*s_objet_argument).type == CPL)
 1926:     {
 1927:         if ((s_objet_resultat = allocation(s_etat_processus, CPL))
 1928:                 == NULL)
 1929:         {
 1930:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1931:             return;
 1932:         }
 1933: 
 1934:         f77cosh_((struct_complexe16 *) (*s_objet_argument).objet,
 1935:                 (struct_complexe16 *) (*s_objet_resultat).objet);
 1936:     }
 1937: 
 1938: /*
 1939: --------------------------------------------------------------------------------
 1940:   Cosinus hyperbolique d'un nom
 1941: --------------------------------------------------------------------------------
 1942: */
 1943: 
 1944:     else if ((*s_objet_argument).type == NOM)
 1945:     {
 1946:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
 1947:                 == NULL)
 1948:         {
 1949:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1950:             return;
 1951:         }
 1952: 
 1953:         if (((*s_objet_resultat).objet =
 1954:                 allocation_maillon(s_etat_processus)) == NULL)
 1955:         {
 1956:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1957:             return;
 1958:         }
 1959: 
 1960:         l_element_courant = (*s_objet_resultat).objet;
 1961: 
 1962:         if (((*l_element_courant).donnee =
 1963:                 allocation(s_etat_processus, FCT)) == NULL)
 1964:         {
 1965:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1966:             return;
 1967:         }
 1968: 
 1969:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1970:                 .nombre_arguments = 0;
 1971:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1972:                 .fonction = instruction_vers_niveau_superieur;
 1973: 
 1974:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1975:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1976:         {
 1977:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1978:             return;
 1979:         }
 1980: 
 1981:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1982:                 .nom_fonction, "<<");
 1983: 
 1984:         if (((*l_element_courant).suivant =
 1985:                 allocation_maillon(s_etat_processus)) == NULL)
 1986:         {
 1987:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1988:             return;
 1989:         }
 1990: 
 1991:         l_element_courant = (*l_element_courant).suivant;
 1992:         (*l_element_courant).donnee = s_objet_argument;
 1993: 
 1994:         if (((*l_element_courant).suivant =
 1995:                 allocation_maillon(s_etat_processus)) == NULL)
 1996:         {
 1997:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1998:             return;
 1999:         }
 2000: 
 2001:         l_element_courant = (*l_element_courant).suivant;
 2002: 
 2003:         if (((*l_element_courant).donnee =
 2004:                 allocation(s_etat_processus, FCT)) == NULL)
 2005:         {
 2006:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2007:             return;
 2008:         }
 2009: 
 2010:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2011:                 .nombre_arguments = 1;
 2012:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2013:                 .fonction = instruction_cosh;
 2014: 
 2015:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2016:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 2017:         {
 2018:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2019:             return;
 2020:         }
 2021: 
 2022:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2023:                 .nom_fonction, "COSH");
 2024: 
 2025:         if (((*l_element_courant).suivant =
 2026:                 allocation_maillon(s_etat_processus)) == NULL)
 2027:         {
 2028:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2029:             return;
 2030:         }
 2031: 
 2032:         l_element_courant = (*l_element_courant).suivant;
 2033: 
 2034:         if (((*l_element_courant).donnee =
 2035:                 allocation(s_etat_processus, FCT)) == NULL)
 2036:         {
 2037:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2038:             return;
 2039:         }
 2040: 
 2041:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2042:                 .nombre_arguments = 0;
 2043:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2044:                 .fonction = instruction_vers_niveau_inferieur;
 2045: 
 2046:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2047:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2048:         {
 2049:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2050:             return;
 2051:         }
 2052: 
 2053:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2054:                 .nom_fonction, ">>");
 2055: 
 2056:         (*l_element_courant).suivant = NULL;
 2057:         s_objet_argument = NULL;
 2058:     }
 2059: 
 2060: /*
 2061: --------------------------------------------------------------------------------
 2062:   Cosinus hyperbolique d'une expression
 2063: --------------------------------------------------------------------------------
 2064: */
 2065: 
 2066:     else if (((*s_objet_argument).type == ALG) ||
 2067:             ((*s_objet_argument).type == RPN))
 2068:     {
 2069:         if ((s_copie_argument = copie_objet(s_etat_processus,
 2070:                 s_objet_argument, 'N')) == NULL)
 2071:         {
 2072:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2073:             return;
 2074:         }
 2075: 
 2076:         l_element_courant = (struct_liste_chainee *)
 2077:                 (*s_copie_argument).objet;
 2078:         l_element_precedent = l_element_courant;
 2079: 
 2080:         while((*l_element_courant).suivant != NULL)
 2081:         {
 2082:             l_element_precedent = l_element_courant;
 2083:             l_element_courant = (*l_element_courant).suivant;
 2084:         }
 2085: 
 2086:         if (((*l_element_precedent).suivant =
 2087:                 allocation_maillon(s_etat_processus)) == NULL)
 2088:         {
 2089:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2090:             return;
 2091:         }
 2092: 
 2093:         if (((*(*l_element_precedent).suivant).donnee =
 2094:                 allocation(s_etat_processus, FCT)) == NULL)
 2095:         {
 2096:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2097:             return;
 2098:         }
 2099: 
 2100:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2101:                 .donnee).objet)).nombre_arguments = 1;
 2102:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2103:                 .donnee).objet)).fonction = instruction_cosh;
 2104: 
 2105:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2106:                 .suivant).donnee).objet)).nom_fonction =
 2107:                 malloc(5 * sizeof(unsigned char))) == NULL)
 2108:         {
 2109:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2110:             return;
 2111:         }
 2112: 
 2113:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2114:                 .suivant).donnee).objet)).nom_fonction, "COSH");
 2115: 
 2116:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2117: 
 2118:         s_objet_resultat = s_copie_argument;
 2119:     }
 2120: 
 2121: /*
 2122: --------------------------------------------------------------------------------
 2123:   Réalisation impossible de la fonction cosinus hyperbolique
 2124: --------------------------------------------------------------------------------
 2125: */
 2126: 
 2127:     else
 2128:     {
 2129:         liberation(s_etat_processus, s_objet_argument);
 2130: 
 2131:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 2132:         return;
 2133:     }
 2134: 
 2135:     liberation(s_etat_processus, s_objet_argument);
 2136: 
 2137:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2138:             s_objet_resultat) == d_erreur)
 2139:     {
 2140:         return;
 2141:     }
 2142: 
 2143:     return;
 2144: }
 2145: 
 2146: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>