File:  [local] / rpl / src / instructions_f1.c
Revision 1.67: download - view: text, annotated - select for diffs - revision graph
Mon Jan 5 15:32:18 2015 UTC (9 years, 4 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route vers la 4.1.20.

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

CVSweb interface <joel.bertrand@systella.fr>