File:  [local] / rpl / src / instructions_f1.c
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs - revision graph
Tue Jan 26 15:22:45 2010 UTC (14 years, 3 months ago) by bertrand
Branches: JKB
CVS tags: start


Commit initial.

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

CVSweb interface <joel.bertrand@systella.fr>