File:  [local] / rpl / src / instructions_a1.c
Revision 1.14: download - view: text, annotated - select for diffs - revision graph
Thu Sep 23 15:27:36 2010 UTC (13 years, 7 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la 4.0.20.

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

CVSweb interface <joel.bertrand@systella.fr>