File:  [local] / rpl / src / instructions_f1.c
Revision 1.43: download - view: text, annotated - select for diffs - revision graph
Thu Oct 4 15:21:26 2012 UTC (11 years, 7 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Première série de patches pour intégrer la gestion des variables statiques
à l'arbre des variables. Attention, cela compile, mais il reste des choses à
faire. Prière de ne pas utilser en l'état de variables statiques.

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

CVSweb interface <joel.bertrand@systella.fr>