File:  [local] / rpl / src / instructions_a1.c
Revision 1.69: download - view: text, annotated - select for diffs - revision graph
Fri Jan 10 11:15:43 2020 UTC (4 years, 2 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 'abort'
   29: ================================================================================
   30:   Entrées : pointeur sur une structure struct_processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_abort(struct_processus *s_etat_processus)
   40: {
   41:     struct timespec                     attente;
   42: 
   43:     (*s_etat_processus).erreur_execution = d_ex;
   44: 
   45:     if ((*s_etat_processus).affichage_arguments == 'Y')
   46:     {
   47:         printf("\n  ABORT ");
   48: 
   49:         if ((*s_etat_processus).langue == 'F')
   50:         {
   51:             printf("(abandon du programme)\n\n");
   52:             printf("  Aucun argument\n");
   53:         }
   54:         else
   55:         {
   56:             printf("(program abort)\n\n");
   57:             printf("  No argument\n");
   58:         }
   59: 
   60:         return;
   61:     }
   62:     else if ((*s_etat_processus).test_instruction == 'Y')
   63:     {
   64:         (*s_etat_processus).nombre_arguments = -1;
   65:         return;
   66:     }
   67:     
   68:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
   69:     {
   70:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
   71:         {
   72:             return;
   73:         }
   74:     }
   75: 
   76:     envoi_signal_processus((*s_etat_processus).pid_processus_pere,
   77:             rpl_sigabort, d_faux);
   78:     (*s_etat_processus).requete_arret = 'Y';
   79: 
   80:     attente.tv_sec = 0;
   81:     attente.tv_nsec = GRANULARITE_us * 1000;
   82: 
   83:     while((*s_etat_processus).var_volatile_requete_arret == 0)
   84:     {
   85:         scrutation_interruptions(s_etat_processus);
   86:         nanosleep(&attente, NULL);
   87:         INCR_GRANULARITE(attente.tv_nsec);
   88:     }
   89: 
   90:     if ((*s_etat_processus).traitement_instruction_halt == d_vrai)
   91:     {
   92:         (*s_etat_processus).execution_pas_suivant = d_vrai;
   93:     }
   94: 
   95:     return;
   96: }
   97: 
   98: 
   99: /*
  100: ================================================================================
  101:   Fonction 'and'
  102: ================================================================================
  103:   Entrées : pointeur sur une structure struct_processus
  104: --------------------------------------------------------------------------------
  105:   Sorties :
  106: --------------------------------------------------------------------------------
  107:   Effets de bord : néant
  108: ================================================================================
  109: */
  110: 
  111: void
  112: instruction_and(struct_processus *s_etat_processus)
  113: {
  114:     struct_liste_chainee        *l_element_courant;
  115:     struct_liste_chainee        *l_element_precedent;
  116: 
  117:     struct_objet                *s_copie_argument_1;
  118:     struct_objet                *s_copie_argument_2;
  119:     struct_objet                *s_objet_argument_1;
  120:     struct_objet                *s_objet_argument_2;
  121:     struct_objet                *s_objet_resultat;
  122: 
  123:     unsigned long               nombre_elements;
  124: 
  125:     (*s_etat_processus).erreur_execution = d_ex;
  126: 
  127:     if ((*s_etat_processus).affichage_arguments == 'Y')
  128:     {
  129:         printf("\n  AND ");
  130: 
  131:         if ((*s_etat_processus).langue == 'F')
  132:         {
  133:             printf("(opérateur et)\n\n");
  134:         }
  135:         else
  136:         {
  137:             printf("(and operator)\n\n");
  138:         }
  139: 
  140:         printf("    2: %s, %s\n", d_INT, d_REL);
  141:         printf("    1: %s, %s\n", d_INT, d_REL);
  142:         printf("->  1: %s\n\n", d_INT);
  143: 
  144:         printf("    2: %s\n", d_BIN);
  145:         printf("    1: %s\n", d_BIN);
  146:         printf("->  1: %s\n\n", d_BIN);
  147: 
  148:         printf("    2: %s\n", d_NOM);
  149:         printf("    1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
  150:         printf("->  1: %s\n\n", d_ALG);
  151: 
  152:         printf("    2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
  153:         printf("    1: %s\n", d_NOM);
  154:         printf("->  1: %s\n\n", d_ALG);
  155: 
  156:         printf("    2: %s\n", d_ALG);
  157:         printf("    1: %s\n", d_ALG);
  158:         printf("->  1: %s\n\n", d_ALG);
  159: 
  160:         printf("    2: %s\n", d_RPN);
  161:         printf("    1: %s\n", d_RPN);
  162:         printf("->  1: %s\n", d_RPN);
  163: 
  164:         return;
  165:     }
  166:     else if ((*s_etat_processus).test_instruction == 'Y')
  167:     {
  168:         (*s_etat_processus).nombre_arguments = 0;
  169:         return;
  170:     }
  171:     
  172:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  173:     {
  174:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
  175:         {
  176:             return;
  177:         }
  178:     }
  179: 
  180:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  181:             &s_objet_argument_1) == d_erreur)
  182:     {
  183:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  184:         return;
  185:     }
  186: 
  187:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  188:             &s_objet_argument_2) == d_erreur)
  189:     {
  190:         liberation(s_etat_processus, s_objet_argument_1);
  191: 
  192:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  193:         return;
  194:     }
  195: 
  196: /*
  197: --------------------------------------------------------------------------------
  198:   AND logique
  199: --------------------------------------------------------------------------------
  200: */
  201: 
  202:     if (((((*s_objet_argument_1).type == INT) ||
  203:             ((*s_objet_argument_1).type == REL)) &&
  204:             (((*s_objet_argument_2).type == INT) ||
  205:             ((*s_objet_argument_2).type == REL))))
  206:     {
  207:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
  208:         {
  209:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  210:             return;
  211:         }
  212: 
  213:         if ((*s_objet_argument_1).type == INT)
  214:         {
  215:             if ((*s_objet_argument_2).type == INT)
  216:             {
  217:                 if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) &&
  218:                         ((*((integer8 *) (*s_objet_argument_2).objet)) != 0))
  219:                 {
  220:                     (*((integer8 *) (*s_objet_resultat).objet)) = -1;
  221:                 }
  222:                 else
  223:                 {
  224:                     (*((integer8 *) (*s_objet_resultat).objet)) = 0;
  225:                 }
  226:             }
  227:             else
  228:             {
  229:                 if (((*((integer8 *) (*s_objet_argument_1).objet)) != 0) &&
  230:                         ((*((real8 *) (*s_objet_argument_2).objet)) != 0))
  231:                 {
  232:                     (*((integer8 *) (*s_objet_resultat).objet)) = -1;
  233:                 }
  234:                 else
  235:                 {
  236:                     (*((integer8 *) (*s_objet_resultat).objet)) = 0;
  237:                 }
  238:             }
  239:         }
  240:         else
  241:         {
  242:             if ((*s_objet_argument_2).type == INT)
  243:             {
  244:                 if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) &&
  245:                         ((*((integer8 *) (*s_objet_argument_2).objet)) != 0))
  246:                 {
  247:                     (*((integer8 *) (*s_objet_resultat).objet)) = -1;
  248:                 }
  249:                 else
  250:                 {
  251:                     (*((integer8 *) (*s_objet_resultat).objet)) = 0;
  252:                 }
  253:             }
  254:             else
  255:             {
  256:                 if (((*((real8 *) (*s_objet_argument_1).objet)) != 0) &&
  257:                         ((*((real8 *) (*s_objet_argument_2).objet)) != 0))
  258:                 {
  259:                     (*((integer8 *) (*s_objet_resultat).objet)) = -1;
  260:                 }
  261:                 else
  262:                 {
  263:                     (*((integer8 *) (*s_objet_resultat).objet)) = 0;
  264:                 }
  265:             }
  266:         }
  267:     }
  268: 
  269: /*
  270: --------------------------------------------------------------------------------
  271:   AND binaire
  272: --------------------------------------------------------------------------------
  273: */
  274: 
  275:     else if (((*s_objet_argument_1).type == BIN) &&
  276:             ((*s_objet_argument_2).type == BIN))
  277:     {
  278:         if ((s_objet_resultat = allocation(s_etat_processus, BIN)) == NULL)
  279:         {
  280:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  281:             return;
  282:         }
  283: 
  284:         (*((logical8 *) (*s_objet_resultat).objet)) = 
  285:                 (*((logical8 *) (*s_objet_argument_1).objet)) &
  286:                 (*((logical8 *) (*s_objet_argument_2).objet));
  287:     }
  288: 
  289: /*
  290: --------------------------------------------------------------------------------
  291:    AND entre des arguments complexes
  292: --------------------------------------------------------------------------------
  293: */
  294: 
  295:     /*
  296:      * Nom ou valeur numérique / Nom ou valeur numérique
  297:      */
  298: 
  299:     else if ((((*s_objet_argument_1).type == NOM) &&
  300:             (((*s_objet_argument_2).type == NOM) ||
  301:             ((*s_objet_argument_2).type == INT) ||
  302:             ((*s_objet_argument_2).type == REL))) ||
  303:             (((*s_objet_argument_2).type == NOM) &&
  304:             (((*s_objet_argument_1).type == INT) ||
  305:             ((*s_objet_argument_1).type == REL))))
  306:     {
  307:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
  308:         {
  309:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  310:             return;
  311:         }
  312: 
  313:         if (((*s_objet_resultat).objet = allocation_maillon(s_etat_processus))
  314:                 == NULL)
  315:         {
  316:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  317:             return;
  318:         }
  319: 
  320:         l_element_courant = (*s_objet_resultat).objet;
  321: 
  322:         if (((*l_element_courant).donnee =
  323:                 allocation(s_etat_processus, FCT)) == NULL)
  324:         {
  325:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  326:             return;
  327:         }
  328: 
  329:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  330:                 .nombre_arguments = 0;
  331:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  332:                 .fonction = instruction_vers_niveau_superieur;
  333: 
  334:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  335:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  336:         {
  337:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  338:             return;
  339:         }
  340: 
  341:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  342:                 .nom_fonction, "<<");
  343: 
  344:         if (((*l_element_courant).suivant =
  345:                 allocation_maillon(s_etat_processus)) == NULL)
  346:         {
  347:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  348:             return;
  349:         }
  350: 
  351:         l_element_courant = (*l_element_courant).suivant;
  352:         (*l_element_courant).donnee = s_objet_argument_2;
  353: 
  354:         if (((*l_element_courant).suivant =
  355:                 allocation_maillon(s_etat_processus)) == NULL)
  356:         {
  357:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  358:             return;
  359:         }
  360: 
  361:         l_element_courant = (*l_element_courant).suivant;
  362:         (*l_element_courant).donnee = s_objet_argument_1;
  363: 
  364:         if (((*l_element_courant).suivant =
  365:                 allocation_maillon(s_etat_processus)) == NULL)
  366:         {
  367:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  368:             return;
  369:         }
  370: 
  371:         l_element_courant = (*l_element_courant).suivant;
  372: 
  373:         if (((*l_element_courant).donnee =
  374:                 allocation(s_etat_processus, FCT)) == NULL)
  375:         {
  376:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  377:             return;
  378:         }
  379: 
  380:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  381:                 .nombre_arguments = 0;
  382:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  383:                 .fonction = instruction_and;
  384: 
  385:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  386:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
  387:         {
  388:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  389:             return;
  390:         }
  391: 
  392:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  393:                 .nom_fonction, "AND");
  394: 
  395:         if (((*l_element_courant).suivant =
  396:                 allocation_maillon(s_etat_processus)) == NULL)
  397:         {
  398:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  399:             return;
  400:         }
  401: 
  402:         l_element_courant = (*l_element_courant).suivant;
  403: 
  404:         if (((*l_element_courant).donnee =
  405:                 allocation(s_etat_processus, FCT)) == NULL)
  406:         {
  407:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  408:             return;
  409:         }
  410: 
  411:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  412:                 .nombre_arguments = 0;
  413:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  414:                 .fonction = instruction_vers_niveau_inferieur;
  415: 
  416:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  417:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  418:         {
  419:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  420:             return;
  421:         }
  422: 
  423:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  424:                 .nom_fonction, ">>");
  425: 
  426:         (*l_element_courant).suivant = NULL;
  427: 
  428:         s_objet_argument_1 = NULL;
  429:         s_objet_argument_2 = NULL;
  430:     }
  431: 
  432:     /*
  433:      * Nom ou valeur numérique / Expression
  434:      */
  435: 
  436:     else if ((((*s_objet_argument_1).type == ALG) ||
  437:             ((*s_objet_argument_1).type == RPN)) &&
  438:             (((*s_objet_argument_2).type == NOM) ||
  439:             ((*s_objet_argument_2).type == INT) ||
  440:             ((*s_objet_argument_2).type == REL)))
  441:     {
  442:         nombre_elements = 0;
  443:         l_element_courant = (struct_liste_chainee *)
  444:                 (*s_objet_argument_1).objet;
  445: 
  446:         while(l_element_courant != NULL)
  447:         {
  448:             nombre_elements++;
  449:             l_element_courant = (*l_element_courant).suivant;
  450:         }
  451: 
  452:         if (nombre_elements == 2)
  453:         {
  454:             liberation(s_etat_processus, s_objet_argument_1);
  455:             liberation(s_etat_processus, s_objet_argument_2);
  456: 
  457:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  458:             return;
  459:         }
  460: 
  461:         if ((s_objet_resultat = copie_objet(s_etat_processus,
  462:                 s_objet_argument_1, 'N')) == NULL)
  463:         {
  464:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  465:             return;
  466:         }
  467: 
  468:         l_element_courant = (struct_liste_chainee *)
  469:                 (*s_objet_resultat).objet;
  470:         l_element_precedent = l_element_courant;
  471:         l_element_courant = (*l_element_courant).suivant;
  472: 
  473:         if (((*l_element_precedent).suivant =
  474:                 allocation_maillon(s_etat_processus)) == NULL)
  475:         {
  476:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  477:             return;
  478:         }
  479: 
  480:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
  481:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  482: 
  483:         while((*l_element_courant).suivant != NULL)
  484:         {
  485:             l_element_precedent = l_element_courant;
  486:             l_element_courant = (*l_element_courant).suivant;
  487:         }
  488: 
  489:         if (((*l_element_precedent).suivant =
  490:                 allocation_maillon(s_etat_processus)) == NULL)
  491:         {
  492:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  493:             return;
  494:         }
  495: 
  496:         if (((*(*l_element_precedent).suivant).donnee =
  497:                 allocation(s_etat_processus, FCT)) == NULL)
  498:         {
  499:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  500:             return;
  501:         }
  502: 
  503:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  504:                 .donnee).objet)).nombre_arguments = 0;
  505:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  506:                 .donnee).objet)).fonction = instruction_and;
  507: 
  508:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
  509:                 .suivant).donnee).objet)).nom_fonction =
  510:                 malloc(4 * sizeof(unsigned char))) == NULL)
  511:         {
  512:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  513:             return;
  514:         }
  515: 
  516:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
  517:                 .suivant).donnee).objet)).nom_fonction, "AND");
  518: 
  519:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  520: 
  521:         s_objet_argument_2 = NULL;
  522:     }
  523: 
  524:     /*
  525:      * Expression / Nom ou valeur numérique
  526:      */
  527: 
  528:     else if ((((*s_objet_argument_1).type == NOM) ||
  529:             ((*s_objet_argument_1).type == INT) ||
  530:             ((*s_objet_argument_1).type == REL)) &&
  531:             (((*s_objet_argument_2).type == ALG) ||
  532:             ((*s_objet_argument_2).type == RPN)))
  533:     {
  534:         nombre_elements = 0;
  535:         l_element_courant = (struct_liste_chainee *)
  536:                 (*s_objet_argument_2).objet;
  537: 
  538:         while(l_element_courant != NULL)
  539:         {
  540:             nombre_elements++;
  541:             l_element_courant = (*l_element_courant).suivant;
  542:         }
  543: 
  544:         if (nombre_elements == 2)
  545:         {
  546:             liberation(s_etat_processus, s_objet_argument_1);
  547:             liberation(s_etat_processus, s_objet_argument_2);
  548: 
  549:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  550:             return;
  551:         }
  552: 
  553:         if ((s_objet_resultat = copie_objet(s_etat_processus,
  554:                 s_objet_argument_2, 'N')) == NULL)
  555:         {
  556:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  557:             return;
  558:         }
  559: 
  560:         l_element_courant = (struct_liste_chainee *)
  561:                 (*s_objet_resultat).objet;
  562:         l_element_precedent = l_element_courant;
  563: 
  564:         while((*l_element_courant).suivant != NULL)
  565:         {
  566:             l_element_precedent = l_element_courant;
  567:             l_element_courant = (*l_element_courant).suivant;
  568:         }
  569: 
  570:         if (((*l_element_precedent).suivant =
  571:                 allocation_maillon(s_etat_processus)) == NULL)
  572:         {
  573:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  574:             return;
  575:         }
  576: 
  577:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
  578:         l_element_precedent = (*l_element_precedent).suivant;
  579: 
  580:         if (((*l_element_precedent).suivant =
  581:                 allocation_maillon(s_etat_processus)) == NULL)
  582:         {
  583:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  584:             return;
  585:         }
  586: 
  587:         if (((*(*l_element_precedent).suivant).donnee =
  588:                 allocation(s_etat_processus, FCT)) == NULL)
  589:         {
  590:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  591:             return;
  592:         }
  593: 
  594:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  595:                 .donnee).objet)).nombre_arguments = 0;
  596:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  597:                 .donnee).objet)).fonction = instruction_and;
  598: 
  599:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
  600:                 .suivant).donnee).objet)).nom_fonction =
  601:                 malloc(4 * sizeof(unsigned char))) == NULL)
  602:         {
  603:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  604:             return;
  605:         }
  606: 
  607:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
  608:                 .suivant).donnee).objet)).nom_fonction, "AND");
  609: 
  610:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  611: 
  612:         s_objet_argument_1 = NULL;
  613:     }
  614: 
  615:     /*
  616:      * Expression / Expression
  617:      */
  618: 
  619:     else if ((((*s_objet_argument_1).type == ALG) &&
  620:             ((*s_objet_argument_2).type == ALG)) ||
  621:             (((*s_objet_argument_1).type == RPN) &&
  622:             ((*s_objet_argument_2).type == RPN)))
  623:     {
  624:         nombre_elements = 0;
  625:         l_element_courant = (struct_liste_chainee *)
  626:                 (*s_objet_argument_1).objet;
  627: 
  628:         while(l_element_courant != NULL)
  629:         {
  630:             nombre_elements++;
  631:             l_element_courant = (*l_element_courant).suivant;
  632:         }
  633: 
  634:         if (nombre_elements == 2)
  635:         {
  636:             liberation(s_etat_processus, s_objet_argument_1);
  637:             liberation(s_etat_processus, s_objet_argument_2);
  638: 
  639:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  640:             return;
  641:         }
  642: 
  643:         nombre_elements = 0;
  644:         l_element_courant = (struct_liste_chainee *)
  645:                 (*s_objet_argument_2).objet;
  646: 
  647:         while(l_element_courant != NULL)
  648:         {
  649:             nombre_elements++;
  650:             l_element_courant = (*l_element_courant).suivant;
  651:         }
  652: 
  653:         if (nombre_elements == 2)
  654:         {
  655:             liberation(s_etat_processus, s_objet_argument_1);
  656:             liberation(s_etat_processus, s_objet_argument_2);
  657: 
  658:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  659:             return;
  660:         }
  661: 
  662:         if ((s_copie_argument_1 = copie_objet(s_etat_processus,
  663:                 s_objet_argument_1, 'N')) == NULL)
  664:         {
  665:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  666:             return;
  667:         }
  668: 
  669:         if ((s_copie_argument_2 = copie_objet(s_etat_processus,
  670:                 s_objet_argument_2, 'N')) == NULL)
  671:         {
  672:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  673:             return;
  674:         }
  675: 
  676:         l_element_courant = (struct_liste_chainee *)
  677:                 (*s_copie_argument_1).objet;
  678:         (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
  679:                 (*s_copie_argument_1).objet)).suivant;
  680: 
  681:         liberation(s_etat_processus, (*l_element_courant).donnee);
  682:         liberation_maillon(s_etat_processus, l_element_courant);
  683: 
  684:         l_element_courant = (struct_liste_chainee *)
  685:                 (*s_copie_argument_2).objet;
  686:         l_element_precedent = l_element_courant;
  687:         s_objet_resultat = s_copie_argument_2;
  688: 
  689:         while((*l_element_courant).suivant != NULL)
  690:         {
  691:             l_element_precedent = l_element_courant;
  692:             l_element_courant = (*l_element_courant).suivant;
  693:         }
  694: 
  695:         liberation(s_etat_processus, (*l_element_courant).donnee);
  696:         liberation_maillon(s_etat_processus, l_element_courant);
  697: 
  698:         (*l_element_precedent).suivant = (struct_liste_chainee *)
  699:                 (*s_copie_argument_1).objet;
  700:         (*s_copie_argument_1).objet = NULL;
  701:         free(s_copie_argument_1);
  702: 
  703:         l_element_courant = (*l_element_precedent).suivant;
  704:         while((*l_element_courant).suivant != NULL)
  705:         {
  706:             l_element_precedent = l_element_courant;
  707:             l_element_courant = (*l_element_courant).suivant;
  708:         }
  709: 
  710:         if (((*l_element_precedent).suivant =
  711:                 allocation_maillon(s_etat_processus)) == NULL)
  712:         {
  713:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  714:             return;
  715:         }
  716: 
  717:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  718:         l_element_courant = (*l_element_precedent).suivant;
  719: 
  720:         if (((*l_element_courant).donnee =
  721:                 allocation(s_etat_processus, FCT)) == NULL)
  722:         {
  723:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  724:             return;
  725:         }
  726: 
  727:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  728:                 .nombre_arguments = 0;
  729:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  730:                 .fonction = instruction_and;
  731: 
  732:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  733:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
  734:         {
  735:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  736:             return;
  737:         }
  738: 
  739:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  740:                 .nom_fonction, "AND");
  741:     }
  742: 
  743: /*
  744: --------------------------------------------------------------------------------
  745:   AND impossible
  746: --------------------------------------------------------------------------------
  747: */
  748: 
  749:     else
  750:     {
  751:         liberation(s_etat_processus, s_objet_argument_1);
  752:         liberation(s_etat_processus, s_objet_argument_2);
  753: 
  754:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  755:         return;
  756:     }
  757: 
  758:     liberation(s_etat_processus, s_objet_argument_1);
  759:     liberation(s_etat_processus, s_objet_argument_2);
  760: 
  761:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  762:             s_objet_resultat) == d_erreur)
  763:     {
  764:         return;
  765:     }
  766: 
  767:     return;
  768: }
  769: 
  770: 
  771: /*
  772: ================================================================================
  773:   Fonction 'abs'
  774: ================================================================================
  775:   Entrées :
  776: --------------------------------------------------------------------------------
  777:   Sorties :
  778: --------------------------------------------------------------------------------
  779:   Effets de bord : néant
  780: ================================================================================
  781: */
  782: 
  783: void
  784: instruction_abs(struct_processus *s_etat_processus)
  785: {
  786:     logical1                            erreur_memoire;
  787: 
  788:     real8                               tampon_flottant;
  789: 
  790:     struct_liste_chainee                *l_element_courant;
  791:     struct_liste_chainee                *l_element_precedent;
  792: 
  793:     struct_objet                        *s_copie_argument;
  794:     struct_objet                        *s_objet_argument;
  795:     struct_objet                        *s_objet_resultat;
  796: 
  797:     integer8                            i;
  798:     integer8                            j;
  799:     integer8                            k;
  800:     integer8                            nombre_elements;
  801: 
  802:     void                                *accumulateur;
  803: 
  804:     (*s_etat_processus).erreur_execution = d_ex;
  805: 
  806:     if ((*s_etat_processus).affichage_arguments == 'Y')
  807:     {
  808:         printf("\n  ABS ");
  809: 
  810:         if ((*s_etat_processus).langue == 'F')
  811:         {
  812:             printf("(norme)\n\n");
  813:         }
  814:         else
  815:         {
  816:             printf("(norm)\n\n");
  817:         }
  818: 
  819:         printf("    1: %s\n", d_INT);
  820:         printf("->  1: %s\n\n", d_INT);
  821: 
  822:         printf("    1: %s, %s\n", d_REL, d_CPL);
  823:         printf("->  1: %s\n\n", d_REL);
  824: 
  825:         printf("    1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
  826:         printf("->  1: %s\n\n", d_REL);
  827: 
  828:         printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
  829:         printf("->  1: %s\n\n", d_REL);
  830: 
  831:         printf("    1: %s, %s\n", d_NOM, d_ALG);
  832:         printf("->  1: %s\n\n", d_ALG);
  833: 
  834:         printf("    1: %s\n", d_RPN);
  835:         printf("->  1: %s\n", d_RPN);
  836: 
  837:         return;
  838:     }
  839:     else if ((*s_etat_processus).test_instruction == 'Y')
  840:     {
  841:         (*s_etat_processus).nombre_arguments = 1;
  842:         return;
  843:     }
  844:     
  845:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  846:     {
  847:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  848:         {
  849:             return;
  850:         }
  851:     }
  852: 
  853:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  854:             &s_objet_argument) == d_erreur)
  855:     {
  856:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  857:         return;
  858:     }
  859: 
  860: /*
  861: --------------------------------------------------------------------------------
  862:   Valeur absolue d'un entier
  863: --------------------------------------------------------------------------------
  864: */
  865: 
  866:     if ((*s_objet_argument).type == INT)
  867:     {
  868:         if ((*((integer8 *) (*s_objet_argument).objet)) != INT64_MIN)
  869:         {
  870:             if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
  871:             {
  872:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  873:                 return;
  874:             }
  875: 
  876:             (*((integer8 *) (*s_objet_resultat).objet)) = abs((*((integer8 *)
  877:                     (*s_objet_argument).objet)));
  878:         }
  879:         else
  880:         {
  881:             if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
  882:             {
  883:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  884:                 return;
  885:             }
  886: 
  887:             (*((real8 *) (*s_objet_resultat).objet)) = abs((real8)
  888:                     ((*((integer8 *) (*s_objet_argument).objet))));
  889:         }
  890:     }
  891: 
  892: /*
  893: --------------------------------------------------------------------------------
  894:   Valeur absolue d'un réel
  895: --------------------------------------------------------------------------------
  896: */
  897: 
  898:     else if ((*s_objet_argument).type == REL)
  899:     {
  900:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
  901:         {
  902:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  903:             return;
  904:         }
  905: 
  906:         (*((real8 *) (*s_objet_resultat).objet)) = fabs(*((real8 *)
  907:                 (*s_objet_argument).objet));
  908:     }
  909: 
  910: /*
  911: --------------------------------------------------------------------------------
  912:   Valeur absolue d'un complexe
  913: --------------------------------------------------------------------------------
  914: */
  915: 
  916:     else if ((*s_objet_argument).type == CPL)
  917:     {
  918:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
  919:         {
  920:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  921:             return;
  922:         }
  923: 
  924:         (*s_objet_resultat).type = REL;
  925:         f77absc_(((struct_complexe16 *) (*s_objet_argument).objet),
  926:                 ((real8 *) (*s_objet_resultat).objet));
  927:     }
  928: 
  929: /*
  930: --------------------------------------------------------------------------------
  931:   Norme de Frobenius d'un tableau
  932: --------------------------------------------------------------------------------
  933: */
  934: 
  935:     /*
  936:      * Vecteur d'entiers
  937:      */
  938: 
  939:     else if ((*s_objet_argument).type == VIN)
  940:     {
  941:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
  942:         {
  943:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  944:             return;
  945:         }
  946: 
  947:         if ((accumulateur = malloc(((size_t) (*(((struct_vecteur *)
  948:                 (*s_objet_argument).objet))).taille) * sizeof(real8))) == NULL)
  949:         {
  950:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  951:             return;
  952:         }
  953: 
  954:         for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
  955:                 .taille; i++)
  956:         {
  957:             ((real8 *) accumulateur)[i] = (real8) (((integer8 *)
  958:                     (*((struct_vecteur *) (*s_objet_argument).objet))
  959:                     .tableau)[i] * ((integer8 *) (*((struct_vecteur *)
  960:                     (*s_objet_argument).objet)).tableau)[i]);
  961:         }
  962: 
  963:         (*((real8 *) (*s_objet_resultat).objet)) =
  964:                 sqrt(sommation_vecteur_reel(accumulateur,
  965:                 &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
  966:                 &erreur_memoire));
  967: 
  968:         if (erreur_memoire == d_vrai)
  969:         {
  970:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  971:             return;
  972:         }
  973: 
  974:         free(accumulateur);
  975:     }
  976: 
  977:     /*
  978:      * Vecteur de réels
  979:      */
  980: 
  981:     else if ((*s_objet_argument).type == VRL)
  982:     {
  983:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
  984:         {
  985:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  986:             return;
  987:         }
  988: 
  989:         if ((accumulateur = malloc(((size_t) (*(((struct_vecteur *)
  990:                 (*s_objet_argument).objet))).taille) * sizeof(real8))) == NULL)
  991:         {
  992:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  993:             return;
  994:         }
  995: 
  996:         for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
  997:                 .taille; i++)
  998:         {
  999:             ((real8 *) accumulateur)[i] = ((real8 *) (*((struct_vecteur *)
 1000:                     (*s_objet_argument).objet)).tableau)[i] *
 1001:                     ((real8 *) (*((struct_vecteur *)
 1002:                     (*s_objet_argument).objet)).tableau)[i];
 1003:         }
 1004: 
 1005:         (*((real8 *) (*s_objet_resultat).objet)) =
 1006:                 sqrt(sommation_vecteur_reel(accumulateur,
 1007:                 &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
 1008:                 &erreur_memoire));
 1009: 
 1010:         if (erreur_memoire == d_vrai)
 1011:         {
 1012:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1013:             return;
 1014:         }
 1015: 
 1016:         free(accumulateur);
 1017:     }
 1018: 
 1019:     /*
 1020:      * Vecteur de complexes
 1021:      */
 1022: 
 1023:     else if ((*s_objet_argument).type == VCX)
 1024:     {
 1025:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1026:         {
 1027:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1028:             return;
 1029:         }
 1030: 
 1031:         if ((accumulateur = malloc(((size_t) (*(((struct_vecteur *)
 1032:                 (*s_objet_argument).objet))).taille) * sizeof(real8))) == NULL)
 1033:         {
 1034:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1035:             return;
 1036:         }
 1037: 
 1038:         for(i = 0; i < (*(((struct_vecteur *) (*s_objet_argument).objet)))
 1039:                 .taille; i++)
 1040:         {
 1041:             f77absc_(&(((struct_complexe16 *) (*((struct_vecteur *)
 1042:                     (*s_objet_argument).objet)).tableau)[i]), &tampon_flottant);
 1043:             ((real8 *) accumulateur)[i] = (tampon_flottant * tampon_flottant);
 1044:         }
 1045: 
 1046:         (*((real8 *) (*s_objet_resultat).objet)) =
 1047:                 sqrt(sommation_vecteur_reel(accumulateur,
 1048:                 &((*(((struct_vecteur *) (*s_objet_argument).objet))).taille),
 1049:                 &erreur_memoire));
 1050: 
 1051:         if (erreur_memoire == d_vrai)
 1052:         {
 1053:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1054:             return;
 1055:         }
 1056: 
 1057:         free(accumulateur);
 1058:     }
 1059: 
 1060:     /*
 1061:      * Matrice d'entiers
 1062:      */
 1063: 
 1064:     else if ((*s_objet_argument).type == MIN)
 1065:     {
 1066:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1067:         {
 1068:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1069:             return;
 1070:         }
 1071: 
 1072:         if ((accumulateur = malloc(((size_t) (nombre_elements =
 1073:                 (*(((struct_matrice *) (*s_objet_argument).objet)))
 1074:                 .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
 1075:                 .objet))).nombre_colonnes)) * sizeof(real8))) == NULL)
 1076:         {
 1077:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1078:             return;
 1079:         }
 1080: 
 1081:         for(k = 0, i = 0; i < (*(((struct_matrice *)
 1082:                 (*s_objet_argument).objet))).nombre_lignes; i++)
 1083:         {
 1084:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
 1085:                     .nombre_colonnes; j++)
 1086:             {
 1087:                 ((real8 *) accumulateur)[k++] = (real8)
 1088:                         (((integer8 **) (*((struct_matrice *)
 1089:                         (*s_objet_argument).objet)).tableau)[i][j] *
 1090:                         ((integer8 **) (*((struct_matrice *)
 1091:                         (*s_objet_argument).objet)).tableau)[i][j]);
 1092:             }
 1093:         }
 1094: 
 1095:         (*((real8 *) (*s_objet_resultat).objet)) =
 1096:                 sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
 1097:                 &erreur_memoire));
 1098: 
 1099:         if (erreur_memoire == d_vrai)
 1100:         {
 1101:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1102:             return;
 1103:         }
 1104: 
 1105:         free(accumulateur);
 1106:     }
 1107: 
 1108:     /*
 1109:      * Matrice de réels
 1110:      */
 1111: 
 1112:     else if ((*s_objet_argument).type == MRL)
 1113:     {
 1114:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1115:         {
 1116:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1117:             return;
 1118:         }
 1119: 
 1120:         if ((accumulateur = malloc(((size_t) (nombre_elements =
 1121:                 (*(((struct_matrice *) (*s_objet_argument).objet)))
 1122:                 .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
 1123:                 .objet))).nombre_colonnes)) * sizeof(real8))) == NULL)
 1124:         {
 1125:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1126:             return;
 1127:         }
 1128: 
 1129:         for(k = 0, i = 0; i < (*(((struct_matrice *)
 1130:                 (*s_objet_argument).objet))).nombre_lignes; i++)
 1131:         {
 1132:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
 1133:                     .nombre_colonnes; j++)
 1134:             {
 1135:                 ((real8 *) accumulateur)[k++] =
 1136:                         ((real8 **) (*((struct_matrice *)
 1137:                         (*s_objet_argument).objet)).tableau)[i][j] *
 1138:                         ((real8 **) (*((struct_matrice *)
 1139:                         (*s_objet_argument).objet)).tableau)[i][j];
 1140:             }
 1141:         }
 1142: 
 1143:         (*((real8 *) (*s_objet_resultat).objet)) =
 1144:                 sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
 1145:                 &erreur_memoire));
 1146: 
 1147:         if (erreur_memoire == d_vrai)
 1148:         {
 1149:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1150:             return;
 1151:         }
 1152: 
 1153:         free(accumulateur);
 1154:     }
 1155: 
 1156:     /*
 1157:      * Matrice de complexes
 1158:      */
 1159: 
 1160:     else if ((*s_objet_argument).type == MCX)
 1161:     {
 1162:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
 1163:         {
 1164:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1165:             return;
 1166:         }
 1167: 
 1168:         if ((accumulateur = malloc(((size_t) (nombre_elements =
 1169:                 (*(((struct_matrice *) (*s_objet_argument).objet)))
 1170:                 .nombre_lignes * (*(((struct_matrice *) (*s_objet_argument)
 1171:                 .objet))).nombre_colonnes)) * sizeof(real8))) == NULL)
 1172:         {
 1173:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1174:             return;
 1175:         }
 1176: 
 1177:         for(k = 0, i = 0; i < (*(((struct_matrice *)
 1178:                 (*s_objet_argument).objet))).nombre_lignes; i++)
 1179:         {
 1180:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_argument).objet)))
 1181:                     .nombre_colonnes; j++)
 1182:             {
 1183:                 f77absc_(&(((struct_complexe16 **) (*((struct_matrice *)
 1184:                         (*s_objet_argument).objet)).tableau)[i][j]),
 1185:                         &tampon_flottant);
 1186:                 ((real8 *) accumulateur)[k++] =
 1187:                         (tampon_flottant * tampon_flottant);
 1188:             }
 1189:         }
 1190: 
 1191:         (*((real8 *) (*s_objet_resultat).objet)) =
 1192:                 sqrt(sommation_vecteur_reel(accumulateur, &nombre_elements,
 1193:                 &erreur_memoire));
 1194: 
 1195:         if (erreur_memoire == d_vrai)
 1196:         {
 1197:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1198:             return;
 1199:         }
 1200: 
 1201:         free(accumulateur);
 1202:     }
 1203: 
 1204: /*
 1205: --------------------------------------------------------------------------------
 1206:   Valeur absolue d'un nom
 1207: --------------------------------------------------------------------------------
 1208: */
 1209: 
 1210:     else if ((*s_objet_argument).type == NOM)
 1211:     {
 1212:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 1213:         {
 1214:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1215:             return;
 1216:         }
 1217: 
 1218:         if (((*s_objet_resultat).objet =
 1219:                 allocation_maillon(s_etat_processus)) == NULL)
 1220:         {
 1221:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1222:             return;
 1223:         }
 1224: 
 1225:         l_element_courant = (*s_objet_resultat).objet;
 1226: 
 1227:         if (((*l_element_courant).donnee =
 1228:                 allocation(s_etat_processus, FCT)) == NULL)
 1229:         {
 1230:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1231:             return;
 1232:         }
 1233: 
 1234:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1235:                 .nombre_arguments = 0;
 1236:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1237:                 .fonction = instruction_vers_niveau_superieur;
 1238: 
 1239:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1240:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1241:         {
 1242:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1243:             return;
 1244:         }
 1245: 
 1246:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1247:                 .nom_fonction, "<<");
 1248: 
 1249:         if (((*l_element_courant).suivant =
 1250:                 allocation_maillon(s_etat_processus)) == NULL)
 1251:         {
 1252:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1253:             return;
 1254:         }
 1255: 
 1256:         l_element_courant = (*l_element_courant).suivant;
 1257:         (*l_element_courant).donnee = s_objet_argument;
 1258: 
 1259:         if (((*l_element_courant).suivant =
 1260:                 allocation_maillon(s_etat_processus)) == NULL)
 1261:         {
 1262:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1263:             return;
 1264:         }
 1265: 
 1266:         l_element_courant = (*l_element_courant).suivant;
 1267: 
 1268:         if (((*l_element_courant).donnee =
 1269:                 allocation(s_etat_processus, FCT)) == NULL)
 1270:         {
 1271:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1272:             return;
 1273:         }
 1274: 
 1275:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1276:                 .nombre_arguments = 1;
 1277:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1278:                 .fonction = instruction_abs;
 1279: 
 1280:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1281:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
 1282:         {
 1283:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1284:             return;
 1285:         }
 1286: 
 1287:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1288:                 .nom_fonction, "ABS");
 1289: 
 1290:         if (((*l_element_courant).suivant =
 1291:                 allocation_maillon(s_etat_processus)) == NULL)
 1292:         {
 1293:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1294:             return;
 1295:         }
 1296: 
 1297:         l_element_courant = (*l_element_courant).suivant;
 1298: 
 1299:         if (((*l_element_courant).donnee =
 1300:                 allocation(s_etat_processus, FCT)) == NULL)
 1301:         {
 1302:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1303:             return;
 1304:         }
 1305: 
 1306:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1307:                 .nombre_arguments = 0;
 1308:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1309:                 .fonction = instruction_vers_niveau_inferieur;
 1310: 
 1311:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1312:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1313:         {
 1314:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1315:             return;
 1316:         }
 1317: 
 1318:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1319:                 .nom_fonction, ">>");
 1320: 
 1321:         (*l_element_courant).suivant = NULL;
 1322:         s_objet_argument = NULL;
 1323:     }
 1324: 
 1325: /*
 1326: --------------------------------------------------------------------------------
 1327:   Valeur absolue d'une expression
 1328: --------------------------------------------------------------------------------
 1329: */
 1330: 
 1331:     else if (((*s_objet_argument).type == ALG) ||
 1332:             ((*s_objet_argument).type == RPN))
 1333:     {
 1334:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1335:                 s_objet_argument, 'N')) == NULL)
 1336:         {
 1337:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1338:             return;
 1339:         }
 1340: 
 1341:         l_element_courant = (struct_liste_chainee *)
 1342:                 (*s_copie_argument).objet;
 1343:         l_element_precedent = l_element_courant;
 1344: 
 1345:         while((*l_element_courant).suivant != NULL)
 1346:         {
 1347:             l_element_precedent = l_element_courant;
 1348:             l_element_courant = (*l_element_courant).suivant;
 1349:         }
 1350: 
 1351:         if (((*l_element_precedent).suivant =
 1352:                 allocation_maillon(s_etat_processus)) == NULL)
 1353:         {
 1354:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1355:             return;
 1356:         }
 1357: 
 1358:         if (((*(*l_element_precedent).suivant).donnee =
 1359:                 allocation(s_etat_processus, FCT)) == NULL)
 1360:         {
 1361:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1362:             return;
 1363:         }
 1364: 
 1365:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1366:                 .donnee).objet)).nombre_arguments = 1;
 1367:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1368:                 .donnee).objet)).fonction = instruction_abs;
 1369: 
 1370:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1371:                 .suivant).donnee).objet)).nom_fonction =
 1372:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1373:         {
 1374:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1375:             return;
 1376:         }
 1377: 
 1378:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1379:                 .suivant).donnee).objet)).nom_fonction, "ABS");
 1380: 
 1381:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1382: 
 1383:         s_objet_resultat = s_copie_argument;
 1384:     }
 1385: 
 1386: /*
 1387: --------------------------------------------------------------------------------
 1388:   Valeur absolue impossible à réaliser
 1389: --------------------------------------------------------------------------------
 1390: */
 1391: 
 1392:     else
 1393:     {
 1394:         liberation(s_etat_processus, s_objet_argument);
 1395: 
 1396:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1397:         return;
 1398:     }
 1399: 
 1400:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1401:             s_objet_resultat) == d_erreur)
 1402:     {
 1403:         return;
 1404:     }
 1405: 
 1406:     liberation(s_etat_processus, s_objet_argument);
 1407: 
 1408:     return;
 1409: }
 1410: 
 1411: 
 1412: /*
 1413: ================================================================================
 1414:   Fonction 'arg'
 1415: ================================================================================
 1416:   Entrées : structure processus
 1417: --------------------------------------------------------------------------------
 1418:   Sorties :
 1419: --------------------------------------------------------------------------------
 1420:   Effets de bord : néant
 1421: ================================================================================
 1422: */
 1423: 
 1424: void
 1425: instruction_arg(struct_processus *s_etat_processus)
 1426: {
 1427:     struct_liste_chainee            *l_element_courant;
 1428:     struct_liste_chainee            *l_element_precedent;
 1429: 
 1430:     struct_objet                    *s_copie_argument;
 1431:     struct_objet                    *s_objet_argument;
 1432:     struct_objet                    *s_objet_resultat;
 1433: 
 1434:     (*s_etat_processus).erreur_execution = d_ex;
 1435: 
 1436:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1437:     {
 1438:         printf("\n  ARG ");
 1439: 
 1440:         if ((*s_etat_processus).langue == 'F')
 1441:         {
 1442:             printf("(argument)\n\n");
 1443:         }
 1444:         else
 1445:         {
 1446:             printf("(argument)\n\n");
 1447:         }
 1448: 
 1449:         printf("    1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
 1450:         printf("->  1: %s\n\n", d_REL);
 1451: 
 1452:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1453:         printf("->  1: %s\n\n", d_ALG);
 1454: 
 1455:         printf("    1: %s\n", d_RPN);
 1456:         printf("->  1: %s\n", d_RPN);
 1457: 
 1458:         return;
 1459:     }
 1460:     else if ((*s_etat_processus).test_instruction == 'Y')
 1461:     {
 1462:         (*s_etat_processus).nombre_arguments = 1;
 1463:         return;
 1464:     }
 1465: 
 1466:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1467:     {
 1468:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1469:         {
 1470:             return;
 1471:         }
 1472:     }
 1473: 
 1474:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1475:             &s_objet_argument) == d_erreur)
 1476:     {
 1477:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1478:         return;
 1479:     }
 1480: 
 1481: /*
 1482: --------------------------------------------------------------------------------
 1483:   Argument d'un entier ou d'un réel
 1484: --------------------------------------------------------------------------------
 1485: */
 1486: 
 1487:     if (((*s_objet_argument).type == INT) ||
 1488:             ((*s_objet_argument).type == REL))
 1489:     {
 1490:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1491:                 == NULL)
 1492:         {
 1493:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1494:             return;
 1495:         }
 1496: 
 1497:         if ((*s_objet_argument).type == INT)
 1498:         {
 1499:             if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
 1500:             {
 1501:                 (*((real8 *) (*s_objet_resultat).objet)) = 0;
 1502:             }
 1503:             else
 1504:             {
 1505:                 (*((real8 *) (*s_objet_resultat).objet)) =
 1506:                         4 * atan((real8) 1);
 1507:             }
 1508:         }
 1509:         else
 1510:         {
 1511:             if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
 1512:             {
 1513:                 (*((real8 *) (*s_objet_resultat).objet)) = 0;
 1514:             }
 1515:             else
 1516:             {
 1517:                 (*((real8 *) (*s_objet_resultat).objet)) =
 1518:                         4 * atan((real8) 1);
 1519: 
 1520:                 if (test_cfsf(s_etat_processus, 60) == d_faux)
 1521:                 {
 1522:                     conversion_radians_vers_degres(&(*((real8 *)
 1523:                             (*s_objet_resultat).objet)));
 1524:                 }
 1525:             }
 1526:         }
 1527:     }
 1528: 
 1529: /*
 1530: --------------------------------------------------------------------------------
 1531:   Argument d'un complexe
 1532: --------------------------------------------------------------------------------
 1533: */
 1534: 
 1535:     else if ((*s_objet_argument).type == CPL)
 1536:     {
 1537:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1538:                 == NULL)
 1539:         {
 1540:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1541:             return;
 1542:         }
 1543: 
 1544:         (*((real8 *) (*s_objet_resultat).objet)) =
 1545:                 atan2((*((struct_complexe16 *) (*s_objet_argument).objet))
 1546:                 .partie_imaginaire, (*((struct_complexe16 *)
 1547:                 (*s_objet_argument).objet)).partie_reelle);
 1548: 
 1549:         if (test_cfsf(s_etat_processus, 60) == d_faux)
 1550:         {
 1551:             conversion_radians_vers_degres(&(*((real8 *)
 1552:                     (*s_objet_resultat).objet)));
 1553:         }
 1554:     }
 1555: 
 1556: /*
 1557: --------------------------------------------------------------------------------
 1558:   Argument d'un nom
 1559: --------------------------------------------------------------------------------
 1560: */
 1561: 
 1562:     else if ((*s_objet_argument).type == NOM)
 1563:     {
 1564:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
 1565:                 == NULL)
 1566:         {
 1567:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1568:             return;
 1569:         }
 1570: 
 1571:         if (((*s_objet_resultat).objet =
 1572:                 allocation_maillon(s_etat_processus)) == NULL)
 1573:         {
 1574:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1575:             return;
 1576:         }
 1577: 
 1578:         l_element_courant = (*s_objet_resultat).objet;
 1579: 
 1580:         if (((*l_element_courant).donnee =
 1581:                 allocation(s_etat_processus, FCT)) == NULL)
 1582:         {
 1583:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1584:             return;
 1585:         }
 1586: 
 1587:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1588:                 .nombre_arguments = 0;
 1589:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1590:                 .fonction = instruction_vers_niveau_superieur;
 1591: 
 1592:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1593:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1594:         {
 1595:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1596:             return;
 1597:         }
 1598: 
 1599:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1600:                 .nom_fonction, "<<");
 1601: 
 1602:         if (((*l_element_courant).suivant =
 1603:                 allocation_maillon(s_etat_processus)) == NULL)
 1604:         {
 1605:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1606:             return;
 1607:         }
 1608: 
 1609:         l_element_courant = (*l_element_courant).suivant;
 1610:         (*l_element_courant).donnee = s_objet_argument;
 1611: 
 1612:         if (((*l_element_courant).suivant =
 1613:                 allocation_maillon(s_etat_processus)) == NULL)
 1614:         {
 1615:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1616:             return;
 1617:         }
 1618: 
 1619:         l_element_courant = (*l_element_courant).suivant;
 1620: 
 1621:         if (((*l_element_courant).donnee =
 1622:                 allocation(s_etat_processus, FCT)) == NULL)
 1623:         {
 1624:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1625:             return;
 1626:         }
 1627: 
 1628:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1629:                 .nombre_arguments = 1;
 1630:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1631:                 .fonction = instruction_arg;
 1632: 
 1633:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1634:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
 1635:         {
 1636:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1637:             return;
 1638:         }
 1639: 
 1640:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1641:                 .nom_fonction, "ARG");
 1642: 
 1643:         if (((*l_element_courant).suivant =
 1644:                 allocation_maillon(s_etat_processus)) == NULL)
 1645:         {
 1646:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1647:             return;
 1648:         }
 1649: 
 1650:         l_element_courant = (*l_element_courant).suivant;
 1651: 
 1652:         if (((*l_element_courant).donnee =
 1653:                 allocation(s_etat_processus, FCT)) == NULL)
 1654:         {
 1655:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1656:             return;
 1657:         }
 1658: 
 1659:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1660:                 .nombre_arguments = 0;
 1661:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1662:                 .fonction = instruction_vers_niveau_inferieur;
 1663: 
 1664:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1665:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1666:         {
 1667:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1668:             return;
 1669:         }
 1670: 
 1671:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1672:                 .nom_fonction, ">>");
 1673: 
 1674:         (*l_element_courant).suivant = NULL;
 1675:         s_objet_argument = NULL;
 1676:     }
 1677: 
 1678: /*
 1679: --------------------------------------------------------------------------------
 1680:   Argument d'une expression
 1681: --------------------------------------------------------------------------------
 1682: */
 1683: 
 1684:     else if (((*s_objet_argument).type == ALG) ||
 1685:             ((*s_objet_argument).type == RPN))
 1686:     {
 1687:         if ((s_copie_argument = copie_objet(s_etat_processus,
 1688:                 s_objet_argument, 'N')) == NULL)
 1689:         {
 1690:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1691:             return;
 1692:         }
 1693: 
 1694:         l_element_courant = (struct_liste_chainee *)
 1695:                 (*s_copie_argument).objet;
 1696:         l_element_precedent = l_element_courant;
 1697: 
 1698:         while((*l_element_courant).suivant != NULL)
 1699:         {
 1700:             l_element_precedent = l_element_courant;
 1701:             l_element_courant = (*l_element_courant).suivant;
 1702:         }
 1703: 
 1704:         if (((*l_element_precedent).suivant =
 1705:                 allocation_maillon(s_etat_processus)) == NULL)
 1706:         {
 1707:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1708:             return;
 1709:         }
 1710: 
 1711:         if (((*(*l_element_precedent).suivant).donnee =
 1712:                 allocation(s_etat_processus, FCT)) == NULL)
 1713:         {
 1714:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1715:             return;
 1716:         }
 1717: 
 1718:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1719:                 .donnee).objet)).nombre_arguments = 1;
 1720:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1721:                 .donnee).objet)).fonction = instruction_arg;
 1722: 
 1723:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1724:                 .suivant).donnee).objet)).nom_fonction =
 1725:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1726:         {
 1727:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1728:             return;
 1729:         }
 1730: 
 1731:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1732:                 .suivant).donnee).objet)).nom_fonction, "ARG");
 1733: 
 1734:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1735: 
 1736:         s_objet_resultat = s_copie_argument;
 1737:     }
 1738: 
 1739: /*
 1740: --------------------------------------------------------------------------------
 1741:   Réalisation impossible de la fonction argument
 1742: --------------------------------------------------------------------------------
 1743: */
 1744: 
 1745:     else
 1746:     {
 1747:         liberation(s_etat_processus, s_objet_argument);
 1748: 
 1749:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1750:         return;
 1751:     }
 1752: 
 1753:     liberation(s_etat_processus, s_objet_argument);
 1754: 
 1755:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1756:             s_objet_resultat) == d_erreur)
 1757:     {
 1758:         return;
 1759:     }
 1760: 
 1761:     return;
 1762: }
 1763: 
 1764: 
 1765: /*
 1766: ================================================================================
 1767:   Fonction 'asin'
 1768: ================================================================================
 1769:   Entrées : pointeur sur une structure struct_processus
 1770: --------------------------------------------------------------------------------
 1771:   Sorties :
 1772: --------------------------------------------------------------------------------
 1773:   Effets de bord : néant
 1774: ================================================================================
 1775: */
 1776: 
 1777: void
 1778: instruction_asin(struct_processus *s_etat_processus)
 1779: {
 1780:     real8                           argument;
 1781: 
 1782:     struct_complexe16               registre;
 1783: 
 1784:     struct_liste_chainee            *l_element_courant;
 1785:     struct_liste_chainee            *l_element_precedent;
 1786: 
 1787:     struct_objet                    *s_copie_argument;
 1788:     struct_objet                    *s_objet_argument;
 1789:     struct_objet                    *s_objet_resultat;
 1790: 
 1791:     (*s_etat_processus).erreur_execution = d_ex;
 1792: 
 1793:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1794:     {
 1795:         printf("\n  ASIN ");
 1796: 
 1797:         if ((*s_etat_processus).langue == 'F')
 1798:         {
 1799:             printf("(arcsinus)\n\n");
 1800:         }
 1801:         else
 1802:         {
 1803:             printf("(arcsine)\n\n");
 1804:         }
 1805: 
 1806:         printf("    1: %s, %s\n", d_INT, d_REL);
 1807:         printf("->  1: %s, %s\n\n", d_REL, d_CPL);
 1808: 
 1809:         printf("    1: %s\n", d_CPL);
 1810:         printf("->  1: %s\n\n", d_CPL);
 1811: 
 1812:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 1813:         printf("->  1: %s\n\n", d_ALG);
 1814: 
 1815:         printf("    1: %s\n", d_RPN);
 1816:         printf("->  1: %s\n", d_RPN);
 1817: 
 1818:         return;
 1819:     }
 1820:     else if ((*s_etat_processus).test_instruction == 'Y')
 1821:     {
 1822:         (*s_etat_processus).nombre_arguments = 1;
 1823:         return;
 1824:     }
 1825: 
 1826:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1827:     {
 1828:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1829:         {
 1830:             return;
 1831:         }
 1832:     }
 1833: 
 1834:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1835:             &s_objet_argument) == d_erreur)
 1836:     {
 1837:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1838:         return;
 1839:     }
 1840: 
 1841: /*
 1842: --------------------------------------------------------------------------------
 1843:   Arcsinus d'un entier ou d'un réel
 1844: --------------------------------------------------------------------------------
 1845: */
 1846: 
 1847:     if (((*s_objet_argument).type == INT) ||
 1848:             ((*s_objet_argument).type == REL))
 1849:     {
 1850:         if ((*s_objet_argument).type == INT)
 1851:         {
 1852:             argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
 1853:         }
 1854:         else
 1855:         {
 1856:             argument = (*((real8 *) (*s_objet_argument).objet));
 1857:         }
 1858: 
 1859:         if ((argument >= -1) && (argument <= 1))
 1860:         {
 1861:             /*
 1862:              * Résultat réel
 1863:              */
 1864: 
 1865:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
 1866:                     == NULL)
 1867:             {
 1868:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1869:                 return;
 1870:             }
 1871: 
 1872:             (*((real8 *) (*s_objet_resultat).objet)) = asin(argument);
 1873: 
 1874:             if (test_cfsf(s_etat_processus, 60) == d_faux)
 1875:             {
 1876:                 conversion_radians_vers_degres((real8 *)
 1877:                         (*s_objet_resultat).objet);
 1878:             }
 1879:         }
 1880:         else
 1881:         {
 1882:             /*
 1883:              * Résultat complexe
 1884:              */
 1885: 
 1886:             registre.partie_reelle = argument;
 1887:             registre.partie_imaginaire = 0;
 1888: 
 1889:             if ((s_objet_resultat = allocation(s_etat_processus, CPL))
 1890:                     == NULL)
 1891:             {
 1892:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1893:                 return;
 1894:             }
 1895: 
 1896:             f77asin_(&registre, (struct_complexe16 *)
 1897:                     (*s_objet_resultat).objet);
 1898:         }
 1899:     }
 1900: 
 1901: /*
 1902: --------------------------------------------------------------------------------
 1903:   Arcsinus d'un complexe
 1904: --------------------------------------------------------------------------------
 1905: */
 1906: 
 1907:     else if ((*s_objet_argument).type == CPL)
 1908:     {
 1909:         if ((s_objet_resultat = allocation(s_etat_processus, CPL))
 1910:                 == NULL)
 1911:         {
 1912:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1913:             return;
 1914:         }
 1915: 
 1916:         f77asin_((struct_complexe16 *) (*s_objet_argument).objet,
 1917:                 (struct_complexe16 *) (*s_objet_resultat).objet);
 1918:     }
 1919: 
 1920: /*
 1921: --------------------------------------------------------------------------------
 1922:   Arcsinus d'un nom
 1923: --------------------------------------------------------------------------------
 1924: */
 1925: 
 1926:     else if ((*s_objet_argument).type == NOM)
 1927:     {
 1928:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
 1929:                 == NULL)
 1930:         {
 1931:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1932:             return;
 1933:         }
 1934: 
 1935:         if (((*s_objet_resultat).objet =
 1936:                 allocation_maillon(s_etat_processus)) == NULL)
 1937:         {
 1938:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1939:             return;
 1940:         }
 1941: 
 1942:         l_element_courant = (*s_objet_resultat).objet;
 1943: 
 1944:         if (((*l_element_courant).donnee =
 1945:                 allocation(s_etat_processus, FCT)) == NULL)
 1946:         {
 1947:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1948:             return;
 1949:         }
 1950: 
 1951:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1952:                 .nombre_arguments = 0;
 1953:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1954:                 .fonction = instruction_vers_niveau_superieur;
 1955: 
 1956:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1957:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1958:         {
 1959:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1960:             return;
 1961:         }
 1962: 
 1963:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1964:                 .nom_fonction, "<<");
 1965: 
 1966:         if (((*l_element_courant).suivant =
 1967:                 allocation_maillon(s_etat_processus)) == NULL)
 1968:         {
 1969:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1970:             return;
 1971:         }
 1972: 
 1973:         l_element_courant = (*l_element_courant).suivant;
 1974:         (*l_element_courant).donnee = s_objet_argument;
 1975: 
 1976:         if (((*l_element_courant).suivant =
 1977:                 allocation_maillon(s_etat_processus)) == NULL)
 1978:         {
 1979:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1980:             return;
 1981:         }
 1982: 
 1983:         l_element_courant = (*l_element_courant).suivant;
 1984: 
 1985:         if (((*l_element_courant).donnee =
 1986:                 allocation(s_etat_processus, FCT)) == NULL)
 1987:         {
 1988:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1989:             return;
 1990:         }
 1991: 
 1992:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1993:                 .nombre_arguments = 1;
 1994:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1995:                 .fonction = instruction_asin;
 1996: 
 1997:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1998:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 1999:         {
 2000:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2001:             return;
 2002:         }
 2003: 
 2004:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2005:                 .nom_fonction, "ASIN");
 2006: 
 2007:         if (((*l_element_courant).suivant =
 2008:                 allocation_maillon(s_etat_processus)) == NULL)
 2009:         {
 2010:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2011:             return;
 2012:         }
 2013: 
 2014:         l_element_courant = (*l_element_courant).suivant;
 2015: 
 2016:         if (((*l_element_courant).donnee =
 2017:                 allocation(s_etat_processus, FCT)) == NULL)
 2018:         {
 2019:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2020:             return;
 2021:         }
 2022: 
 2023:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2024:                 .nombre_arguments = 0;
 2025:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2026:                 .fonction = instruction_vers_niveau_inferieur;
 2027: 
 2028:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2029:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2030:         {
 2031:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2032:             return;
 2033:         }
 2034: 
 2035:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2036:                 .nom_fonction, ">>");
 2037: 
 2038:         (*l_element_courant).suivant = NULL;
 2039:         s_objet_argument = NULL;
 2040:     }
 2041: 
 2042: /*
 2043: --------------------------------------------------------------------------------
 2044:   Arcsinus d'une expression
 2045: --------------------------------------------------------------------------------
 2046: */
 2047: 
 2048:     else if (((*s_objet_argument).type == ALG) ||
 2049:             ((*s_objet_argument).type == RPN))
 2050:     {
 2051:         if ((s_copie_argument = copie_objet(s_etat_processus,
 2052:                 s_objet_argument, 'N')) == NULL)
 2053:         {
 2054:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2055:             return;
 2056:         }
 2057: 
 2058:         l_element_courant = (struct_liste_chainee *)
 2059:                 (*s_copie_argument).objet;
 2060:         l_element_precedent = l_element_courant;
 2061: 
 2062:         while((*l_element_courant).suivant != NULL)
 2063:         {
 2064:             l_element_precedent = l_element_courant;
 2065:             l_element_courant = (*l_element_courant).suivant;
 2066:         }
 2067: 
 2068:         if (((*l_element_precedent).suivant =
 2069:                 allocation_maillon(s_etat_processus)) == NULL)
 2070:         {
 2071:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2072:             return;
 2073:         }
 2074: 
 2075:         if (((*(*l_element_precedent).suivant).donnee =
 2076:                 allocation(s_etat_processus, FCT)) == NULL)
 2077:         {
 2078:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2079:             return;
 2080:         }
 2081: 
 2082:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2083:                 .donnee).objet)).nombre_arguments = 1;
 2084:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2085:                 .donnee).objet)).fonction = instruction_asin;
 2086: 
 2087:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2088:                 .suivant).donnee).objet)).nom_fonction =
 2089:                 malloc(5 * sizeof(unsigned char))) == NULL)
 2090:         {
 2091:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2092:             return;
 2093:         }
 2094: 
 2095:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2096:                 .suivant).donnee).objet)).nom_fonction, "ASIN");
 2097: 
 2098:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2099: 
 2100:         s_objet_resultat = s_copie_argument;
 2101:     }
 2102: 
 2103: /*
 2104: --------------------------------------------------------------------------------
 2105:   Réalisation impossible de la fonction arcsinus
 2106: --------------------------------------------------------------------------------
 2107: */
 2108: 
 2109:     else
 2110:     {
 2111:         liberation(s_etat_processus, s_objet_argument);
 2112: 
 2113:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 2114:         return;
 2115:     }
 2116: 
 2117:     liberation(s_etat_processus, s_objet_argument);
 2118: 
 2119:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2120:             s_objet_resultat) == d_erreur)
 2121:     {
 2122:         return;
 2123:     }
 2124: 
 2125:     return;
 2126: }
 2127: 
 2128: 
 2129: /*
 2130: ================================================================================
 2131:   Fonction 'acos'
 2132: ================================================================================
 2133:   Entrées : pointeur sur une structure struct_processus
 2134: --------------------------------------------------------------------------------
 2135:   Sorties :
 2136: --------------------------------------------------------------------------------
 2137:   Effets de bord : néant
 2138: ================================================================================
 2139: */
 2140: 
 2141: void
 2142: instruction_acos(struct_processus *s_etat_processus)
 2143: {
 2144:     real8                           argument;
 2145: 
 2146:     struct_complexe16               registre;
 2147: 
 2148:     struct_liste_chainee            *l_element_courant;
 2149:     struct_liste_chainee            *l_element_precedent;
 2150: 
 2151:     struct_objet                    *s_copie_argument;
 2152:     struct_objet                    *s_objet_argument;
 2153:     struct_objet                    *s_objet_resultat;
 2154: 
 2155:     (*s_etat_processus).erreur_execution = d_ex;
 2156: 
 2157:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2158:     {
 2159:         printf("\n  ACOS ");
 2160: 
 2161:         if ((*s_etat_processus).langue == 'F')
 2162:         {
 2163:             printf("(arccosinus)\n\n");
 2164:         }
 2165:         else
 2166:         {
 2167:             printf("(arccosine)\n\n");
 2168:         }
 2169: 
 2170:         printf("    1: %s, %s\n", d_INT, d_REL);
 2171:         printf("->  1: %s, %s\n\n", d_REL, d_CPL);
 2172: 
 2173:         printf("    1: %s\n", d_CPL);
 2174:         printf("->  1: %s\n\n", d_CPL);
 2175: 
 2176:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 2177:         printf("->  1: %s\n\n", d_ALG);
 2178: 
 2179:         printf("    1: %s\n", d_RPN);
 2180:         printf("->  1: %s\n", d_RPN);
 2181: 
 2182:         return;
 2183:     }
 2184:     else if ((*s_etat_processus).test_instruction == 'Y')
 2185:     {
 2186:         (*s_etat_processus).nombre_arguments = 1;
 2187:         return;
 2188:     }
 2189: 
 2190:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2191:     {
 2192:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 2193:         {
 2194:             return;
 2195:         }
 2196:     }
 2197: 
 2198:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2199:             &s_objet_argument) == d_erreur)
 2200:     {
 2201:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2202:         return;
 2203:     }
 2204: 
 2205: /*
 2206: --------------------------------------------------------------------------------
 2207:   Arccossinus d'un entier ou d'un réel
 2208: --------------------------------------------------------------------------------
 2209: */
 2210: 
 2211:     if (((*s_objet_argument).type == INT) ||
 2212:             ((*s_objet_argument).type == REL))
 2213:     {
 2214:         if ((*s_objet_argument).type == INT)
 2215:         {
 2216:             argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
 2217:         }
 2218:         else
 2219:         {
 2220:             argument = (*((real8 *) (*s_objet_argument).objet));
 2221:         }
 2222: 
 2223:         if ((argument >= -1) && (argument <= 1))
 2224:         {
 2225:             /*
 2226:              * Résultat réel
 2227:              */
 2228: 
 2229:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
 2230:                     == NULL)
 2231:             {
 2232:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2233:                 return;
 2234:             }
 2235: 
 2236:             (*((real8 *) (*s_objet_resultat).objet)) = acos(argument);
 2237: 
 2238:             if (test_cfsf(s_etat_processus, 60) == d_faux)
 2239:             {
 2240:                 conversion_radians_vers_degres((real8 *)
 2241:                         (*s_objet_resultat).objet);
 2242:             }
 2243:         }
 2244:         else
 2245:         {
 2246:             /*
 2247:              * Résultat complexe
 2248:              */
 2249: 
 2250:             registre.partie_reelle = argument;
 2251:             registre.partie_imaginaire = 0;
 2252: 
 2253:             if ((s_objet_resultat = allocation(s_etat_processus, CPL))
 2254:                     == NULL)
 2255:             {
 2256:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2257:                 return;
 2258:             }
 2259: 
 2260:             f77acos_(&registre, (struct_complexe16 *)
 2261:                     (*s_objet_resultat).objet);
 2262:         }
 2263:     }
 2264: 
 2265: /*
 2266: --------------------------------------------------------------------------------
 2267:   Arccossinus d'un complexe
 2268: --------------------------------------------------------------------------------
 2269: */
 2270: 
 2271:     else if ((*s_objet_argument).type == CPL)
 2272:     {
 2273:         if ((s_objet_resultat = allocation(s_etat_processus, CPL))
 2274:                 == NULL)
 2275:         {
 2276:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2277:             return;
 2278:         }
 2279: 
 2280:         f77acos_((struct_complexe16 *) (*s_objet_argument).objet,
 2281:                 (struct_complexe16 *) (*s_objet_resultat).objet);
 2282:     }
 2283: 
 2284: /*
 2285: --------------------------------------------------------------------------------
 2286:   Arccossinus d'un nom
 2287: --------------------------------------------------------------------------------
 2288: */
 2289: 
 2290:     else if ((*s_objet_argument).type == NOM)
 2291:     {
 2292:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
 2293:                 == NULL)
 2294:         {
 2295:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2296:             return;
 2297:         }
 2298: 
 2299:         if (((*s_objet_resultat).objet =
 2300:                 allocation_maillon(s_etat_processus)) == NULL)
 2301:         {
 2302:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2303:             return;
 2304:         }
 2305: 
 2306:         l_element_courant = (*s_objet_resultat).objet;
 2307: 
 2308:         if (((*l_element_courant).donnee =
 2309:                 allocation(s_etat_processus, FCT)) == NULL)
 2310:         {
 2311:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2312:             return;
 2313:         }
 2314: 
 2315:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2316:                 .nombre_arguments = 0;
 2317:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2318:                 .fonction = instruction_vers_niveau_superieur;
 2319: 
 2320:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2321:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2322:         {
 2323:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2324:             return;
 2325:         }
 2326: 
 2327:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2328:                 .nom_fonction, "<<");
 2329: 
 2330:         if (((*l_element_courant).suivant =
 2331:                 allocation_maillon(s_etat_processus)) == NULL)
 2332:         {
 2333:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2334:             return;
 2335:         }
 2336: 
 2337:         l_element_courant = (*l_element_courant).suivant;
 2338:         (*l_element_courant).donnee = s_objet_argument;
 2339: 
 2340:         if (((*l_element_courant).suivant =
 2341:                 allocation_maillon(s_etat_processus)) == NULL)
 2342:         {
 2343:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2344:             return;
 2345:         }
 2346: 
 2347:         l_element_courant = (*l_element_courant).suivant;
 2348: 
 2349:         if (((*l_element_courant).donnee =
 2350:                 allocation(s_etat_processus, FCT)) == NULL)
 2351:         {
 2352:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2353:             return;
 2354:         }
 2355: 
 2356:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2357:                 .nombre_arguments = 1;
 2358:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2359:                 .fonction = instruction_acos;
 2360: 
 2361:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2362:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 2363:         {
 2364:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2365:             return;
 2366:         }
 2367: 
 2368:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2369:                 .nom_fonction, "ACOS");
 2370: 
 2371:         if (((*l_element_courant).suivant =
 2372:                 allocation_maillon(s_etat_processus)) == NULL)
 2373:         {
 2374:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2375:             return;
 2376:         }
 2377: 
 2378:         l_element_courant = (*l_element_courant).suivant;
 2379: 
 2380:         if (((*l_element_courant).donnee =
 2381:                 allocation(s_etat_processus, FCT)) == NULL)
 2382:         {
 2383:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2384:             return;
 2385:         }
 2386: 
 2387:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2388:                 .nombre_arguments = 0;
 2389:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2390:                 .fonction = instruction_vers_niveau_inferieur;
 2391: 
 2392:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2393:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2394:         {
 2395:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2396:             return;
 2397:         }
 2398: 
 2399:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2400:                 .nom_fonction, ">>");
 2401: 
 2402:         (*l_element_courant).suivant = NULL;
 2403:         s_objet_argument = NULL;
 2404:     }
 2405: 
 2406: /*
 2407: --------------------------------------------------------------------------------
 2408:   Arccossinus d'une expression
 2409: --------------------------------------------------------------------------------
 2410: */
 2411: 
 2412:     else if (((*s_objet_argument).type == ALG) ||
 2413:             ((*s_objet_argument).type == RPN))
 2414:     {
 2415:         if ((s_copie_argument = copie_objet(s_etat_processus,
 2416:                 s_objet_argument, 'N')) == NULL)
 2417:         {
 2418:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2419:             return;
 2420:         }
 2421: 
 2422:         l_element_courant = (struct_liste_chainee *)
 2423:                 (*s_copie_argument).objet;
 2424:         l_element_precedent = l_element_courant;
 2425: 
 2426:         while((*l_element_courant).suivant != NULL)
 2427:         {
 2428:             l_element_precedent = l_element_courant;
 2429:             l_element_courant = (*l_element_courant).suivant;
 2430:         }
 2431: 
 2432:         if (((*l_element_precedent).suivant =
 2433:                 allocation_maillon(s_etat_processus)) == NULL)
 2434:         {
 2435:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2436:             return;
 2437:         }
 2438: 
 2439:         if (((*(*l_element_precedent).suivant).donnee =
 2440:                 allocation(s_etat_processus, FCT)) == NULL)
 2441:         {
 2442:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2443:             return;
 2444:         }
 2445: 
 2446:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2447:                 .donnee).objet)).nombre_arguments = 1;
 2448:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2449:                 .donnee).objet)).fonction = instruction_acos;
 2450: 
 2451:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2452:                 .suivant).donnee).objet)).nom_fonction =
 2453:                 malloc(5 * sizeof(unsigned char))) == NULL)
 2454:         {
 2455:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2456:             return;
 2457:         }
 2458: 
 2459:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2460:                 .suivant).donnee).objet)).nom_fonction, "ACOS");
 2461: 
 2462:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2463: 
 2464:         s_objet_resultat = s_copie_argument;
 2465:     }
 2466: 
 2467: /*
 2468: --------------------------------------------------------------------------------
 2469:   Réalisation impossible de la fonction arccosinus
 2470: --------------------------------------------------------------------------------
 2471: */
 2472: 
 2473:     else
 2474:     {
 2475:         liberation(s_etat_processus, s_objet_argument);
 2476: 
 2477:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 2478:         return;
 2479:     }
 2480: 
 2481:     liberation(s_etat_processus, s_objet_argument);
 2482: 
 2483:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2484:             s_objet_resultat) == d_erreur)
 2485:     {
 2486:         return;
 2487:     }
 2488: 
 2489:     return;
 2490: }
 2491: 
 2492: 
 2493: /*
 2494: ================================================================================
 2495:   Fonction 'atan'
 2496: ================================================================================
 2497:   Entrées : pointeur sur une structure struct_processus
 2498: --------------------------------------------------------------------------------
 2499:   Sorties :
 2500: --------------------------------------------------------------------------------
 2501:   Effets de bord : néant
 2502: ================================================================================
 2503: */
 2504: 
 2505: void
 2506: instruction_atan(struct_processus *s_etat_processus)
 2507: {
 2508:     real8                           argument;
 2509: 
 2510:     integer4                        erreur;
 2511: 
 2512:     struct_liste_chainee            *l_element_courant;
 2513:     struct_liste_chainee            *l_element_precedent;
 2514: 
 2515:     struct_objet                    *s_copie_argument;
 2516:     struct_objet                    *s_objet_argument;
 2517:     struct_objet                    *s_objet_resultat;
 2518: 
 2519:     (*s_etat_processus).erreur_execution = d_ex;
 2520: 
 2521:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2522:     {
 2523:         printf("\n  ATAN ");
 2524: 
 2525:         if ((*s_etat_processus).langue == 'F')
 2526:         {
 2527:             printf("(arctangente)\n\n");
 2528:         }
 2529:         else
 2530:         {
 2531:             printf("(arctangent)\n\n");
 2532:         }
 2533: 
 2534:         printf("    1: %s, %s\n", d_INT, d_REL);
 2535:         printf("->  1: %s, %s\n\n", d_REL, d_CPL);
 2536: 
 2537:         printf("    1: %s\n", d_CPL);
 2538:         printf("->  1: %s\n\n", d_CPL);
 2539: 
 2540:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 2541:         printf("->  1: %s\n\n", d_ALG);
 2542: 
 2543:         printf("    1: %s\n", d_RPN);
 2544:         printf("->  1: %s\n", d_RPN);
 2545: 
 2546:         return;
 2547:     }
 2548:     else if ((*s_etat_processus).test_instruction == 'Y')
 2549:     {
 2550:         (*s_etat_processus).nombre_arguments = 1;
 2551:         return;
 2552:     }
 2553: 
 2554:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2555:     {
 2556:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 2557:         {
 2558:             return;
 2559:         }
 2560:     }
 2561: 
 2562:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2563:             &s_objet_argument) == d_erreur)
 2564:     {
 2565:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2566:         return;
 2567:     }
 2568: 
 2569: /*
 2570: --------------------------------------------------------------------------------
 2571:   Arctangente d'un entier ou d'un réel
 2572: --------------------------------------------------------------------------------
 2573: */
 2574: 
 2575:     if (((*s_objet_argument).type == INT) ||
 2576:             ((*s_objet_argument).type == REL))
 2577:     {
 2578:         if ((*s_objet_argument).type == INT)
 2579:         {
 2580:             argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
 2581:         }
 2582:         else
 2583:         {
 2584:             argument = (*((real8 *) (*s_objet_argument).objet));
 2585:         }
 2586: 
 2587:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
 2588:                 == NULL)
 2589:         {
 2590:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2591:             return;
 2592:         }
 2593: 
 2594:         (*((real8 *) (*s_objet_resultat).objet)) = atan(argument);
 2595: 
 2596:         if (test_cfsf(s_etat_processus, 60) == d_faux)
 2597:         {
 2598:             conversion_radians_vers_degres((real8 *)
 2599:                     (*s_objet_resultat).objet);
 2600:         }
 2601:     }
 2602: 
 2603: /*
 2604: --------------------------------------------------------------------------------
 2605:   Arctangente d'un complexe
 2606: --------------------------------------------------------------------------------
 2607: */
 2608: 
 2609:     else if ((*s_objet_argument).type == CPL)
 2610:     {
 2611:         if ((s_objet_resultat = allocation(s_etat_processus, CPL))
 2612:                 == NULL)
 2613:         {
 2614:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2615:             return;
 2616:         }
 2617: 
 2618:         f77atan_((struct_complexe16 *) (*s_objet_argument).objet,
 2619:                 (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
 2620: 
 2621:         if (erreur != 0)
 2622:         {
 2623:             liberation(s_etat_processus, s_objet_argument);
 2624:             liberation(s_etat_processus, s_objet_resultat);
 2625: 
 2626:             free(s_objet_resultat);
 2627: 
 2628:             (*s_etat_processus).exception = d_ep_division_par_zero;
 2629:             return;
 2630:         }
 2631:     }
 2632: 
 2633: /*
 2634: --------------------------------------------------------------------------------
 2635:   Arctangente d'un nom
 2636: --------------------------------------------------------------------------------
 2637: */
 2638: 
 2639:     else if ((*s_objet_argument).type == NOM)
 2640:     {
 2641:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
 2642:                 == NULL)
 2643:         {
 2644:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2645:             return;
 2646:         }
 2647: 
 2648:         if (((*s_objet_resultat).objet =
 2649:                 allocation_maillon(s_etat_processus)) == NULL)
 2650:         {
 2651:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2652:             return;
 2653:         }
 2654: 
 2655:         l_element_courant = (*s_objet_resultat).objet;
 2656: 
 2657:         if (((*l_element_courant).donnee =
 2658:                 allocation(s_etat_processus, FCT)) == NULL)
 2659:         {
 2660:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2661:             return;
 2662:         }
 2663: 
 2664:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2665:                 .nombre_arguments = 0;
 2666:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2667:                 .fonction = instruction_vers_niveau_superieur;
 2668: 
 2669:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2670:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2671:         {
 2672:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2673:             return;
 2674:         }
 2675: 
 2676:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2677:                 .nom_fonction, "<<");
 2678: 
 2679:         if (((*l_element_courant).suivant =
 2680:                 allocation_maillon(s_etat_processus)) == NULL)
 2681:         {
 2682:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2683:             return;
 2684:         }
 2685: 
 2686:         l_element_courant = (*l_element_courant).suivant;
 2687:         (*l_element_courant).donnee = s_objet_argument;
 2688: 
 2689:         if (((*l_element_courant).suivant =
 2690:                 allocation_maillon(s_etat_processus)) == NULL)
 2691:         {
 2692:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2693:             return;
 2694:         }
 2695: 
 2696:         l_element_courant = (*l_element_courant).suivant;
 2697: 
 2698:         if (((*l_element_courant).donnee =
 2699:                 allocation(s_etat_processus, FCT)) == NULL)
 2700:         {
 2701:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2702:             return;
 2703:         }
 2704: 
 2705:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2706:                 .nombre_arguments = 1;
 2707:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2708:                 .fonction = instruction_atan;
 2709: 
 2710:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2711:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 2712:         {
 2713:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2714:             return;
 2715:         }
 2716: 
 2717:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2718:                 .nom_fonction, "ATAN");
 2719: 
 2720:         if (((*l_element_courant).suivant =
 2721:                 allocation_maillon(s_etat_processus)) == NULL)
 2722:         {
 2723:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2724:             return;
 2725:         }
 2726: 
 2727:         l_element_courant = (*l_element_courant).suivant;
 2728: 
 2729:         if (((*l_element_courant).donnee =
 2730:                 allocation(s_etat_processus, FCT)) == NULL)
 2731:         {
 2732:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2733:             return;
 2734:         }
 2735: 
 2736:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2737:                 .nombre_arguments = 0;
 2738:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2739:                 .fonction = instruction_vers_niveau_inferieur;
 2740: 
 2741:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2742:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2743:         {
 2744:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2745:             return;
 2746:         }
 2747: 
 2748:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2749:                 .nom_fonction, ">>");
 2750: 
 2751:         (*l_element_courant).suivant = NULL;
 2752:         s_objet_argument = NULL;
 2753:     }
 2754: 
 2755: /*
 2756: --------------------------------------------------------------------------------
 2757:   Arctangente d'une expression
 2758: --------------------------------------------------------------------------------
 2759: */
 2760: 
 2761:     else if (((*s_objet_argument).type == ALG) ||
 2762:             ((*s_objet_argument).type == RPN))
 2763:     {
 2764:         if ((s_copie_argument = copie_objet(s_etat_processus,
 2765:                 s_objet_argument, 'N')) == NULL)
 2766:         {
 2767:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2768:             return;
 2769:         }
 2770: 
 2771:         l_element_courant = (struct_liste_chainee *)
 2772:                 (*s_copie_argument).objet;
 2773:         l_element_precedent = l_element_courant;
 2774: 
 2775:         while((*l_element_courant).suivant != NULL)
 2776:         {
 2777:             l_element_precedent = l_element_courant;
 2778:             l_element_courant = (*l_element_courant).suivant;
 2779:         }
 2780: 
 2781:         if (((*l_element_precedent).suivant =
 2782:                 allocation_maillon(s_etat_processus)) == NULL)
 2783:         {
 2784:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2785:             return;
 2786:         }
 2787: 
 2788:         if (((*(*l_element_precedent).suivant).donnee =
 2789:                 allocation(s_etat_processus, FCT)) == NULL)
 2790:         {
 2791:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2792:             return;
 2793:         }
 2794: 
 2795:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2796:                 .donnee).objet)).nombre_arguments = 1;
 2797:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2798:                 .donnee).objet)).fonction = instruction_atan;
 2799: 
 2800:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2801:                 .suivant).donnee).objet)).nom_fonction =
 2802:                 malloc(5 * sizeof(unsigned char))) == NULL)
 2803:         {
 2804:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2805:             return;
 2806:         }
 2807: 
 2808:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2809:                 .suivant).donnee).objet)).nom_fonction, "ATAN");
 2810: 
 2811:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2812: 
 2813:         s_objet_resultat = s_copie_argument;
 2814:     }
 2815: 
 2816: /*
 2817: --------------------------------------------------------------------------------
 2818:   Réalisation impossible de la fonction arctangente
 2819: --------------------------------------------------------------------------------
 2820: */
 2821: 
 2822:     else
 2823:     {
 2824:         liberation(s_etat_processus, s_objet_argument);
 2825: 
 2826:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 2827:         return;
 2828:     }
 2829: 
 2830:     liberation(s_etat_processus, s_objet_argument);
 2831: 
 2832:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2833:             s_objet_resultat) == d_erreur)
 2834:     {
 2835:         return;
 2836:     }
 2837: 
 2838:     return;
 2839: }
 2840: 
 2841: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>