File:  [local] / rpl / src / instructions_f1.c
Revision 1.49: download - view: text, annotated - select for diffs - revision graph
Tue Dec 18 13:19:36 2012 UTC (11 years, 4 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la 4.1.12 !

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

CVSweb interface <joel.bertrand@systella.fr>