File:  [local] / rpl / src / instructions_f1.c
Revision 1.16: download - view: text, annotated - select for diffs - revision graph
Fri Aug 6 15:33:00 2010 UTC (13 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_0_18, HEAD
Cohérence

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

CVSweb interface <joel.bertrand@systella.fr>