File:  [local] / rpl / src / instructions_f1.c
Revision 1.47: download - view: text, annotated - select for diffs - revision graph
Mon Dec 17 21:22:43 2012 UTC (11 years, 4 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Série de patches pour les variables partagées. Les patches ne provoquent pas
de segfault, mais n'ont pas encore été testés sur des variables partagées.

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

CVSweb interface <joel.bertrand@systella.fr>