File:  [local] / rpl / src / instructions_f1.c
Revision 1.44: download - view: text, annotated - select for diffs - revision graph
Sun Oct 7 08:18:36 2012 UTC (11 years, 6 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Autre série de patches pour les variables statiques. Attention, il
reste une erreur de violation d'accès.

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

CVSweb interface <joel.bertrand@systella.fr>