File:  [local] / rpl / src / instructions_f1.c
Revision 1.60: download - view: text, annotated - select for diffs - revision graph
Tue Dec 3 09:36:13 2013 UTC (10 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la 4.1.17.

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

CVSweb interface <joel.bertrand@systella.fr>