File:  [local] / rpl / src / instructions_p3.c
Revision 1.69: download - view: text, annotated - select for diffs - revision graph
Fri Jan 10 11:15:47 2020 UTC (4 years, 3 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_32, HEAD
Modification du copyright.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.32
    4:   Copyright (C) 1989-2020 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 :
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_pourcent(struct_processus *s_etat_processus)
   40: {
   41:     struct_liste_chainee        *l_element_courant;
   42:     struct_liste_chainee        *l_element_precedent;
   43: 
   44:     struct_objet                *s_copie_argument_1;
   45:     struct_objet                *s_copie_argument_2;
   46:     struct_objet                *s_objet_argument_1;
   47:     struct_objet                *s_objet_argument_2;
   48:     struct_objet                *s_objet_resultat;
   49: 
   50:     integer8                    nombre_elements;
   51: 
   52:     (*s_etat_processus).erreur_execution = d_ex;
   53: 
   54:     if ((*s_etat_processus).affichage_arguments == 'Y')
   55:     {
   56:         printf("\n  %% ");
   57: 
   58:         if ((*s_etat_processus).langue == 'F')
   59:         {
   60:             printf("(pourcentage)\n\n");
   61:         }
   62:         else
   63:         {
   64:             printf("(percentage)\n\n");
   65:         }
   66: 
   67:         printf("    2: %s, %s\n", d_INT, d_REL);
   68:         printf("    1: %s, %s\n", d_INT, d_REL);
   69:         printf("->  1: %s\n\n", d_REL);
   70: 
   71:         printf("    2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
   72:         printf("    1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
   73:         printf("->  1: %s\n\n", d_ALG);
   74: 
   75:         printf("    2: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
   76:         printf("    1: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
   77:         printf("->  1: %s\n", d_RPN);
   78: 
   79:         return;
   80:     }
   81:     else if ((*s_etat_processus).test_instruction == 'Y')
   82:     {
   83:         (*s_etat_processus).nombre_arguments = -1;
   84:         return;
   85:     }
   86:     
   87:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
   88:     {
   89:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
   90:         {
   91:             return;
   92:         }
   93:     }
   94: 
   95:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
   96:             &s_objet_argument_1) == d_erreur)
   97:     {
   98:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
   99:         return;
  100:     }
  101: 
  102:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  103:             &s_objet_argument_2) == d_erreur)
  104:     {
  105:         liberation(s_etat_processus, s_objet_argument_1);
  106: 
  107:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  108:         return;
  109:     }
  110: 
  111: /*
  112: --------------------------------------------------------------------------------
  113:   % portant sur des valeurs numériques
  114: --------------------------------------------------------------------------------
  115: */
  116: 
  117:     if ((((*s_objet_argument_1).type == INT) ||
  118:             ((*s_objet_argument_1).type == REL)) &&
  119:             (((*s_objet_argument_2).type == INT) ||
  120:             ((*s_objet_argument_2).type == REL)))
  121:     {
  122:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
  123:                 == NULL)
  124:         {
  125:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  126:             return;
  127:         }
  128: 
  129:         if ((*s_objet_argument_1).type == INT)
  130:         {
  131:             if ((*s_objet_argument_2).type == INT)
  132:             {
  133:                 (*((real8 *) (*s_objet_resultat).objet)) =
  134:                         (((real8) (*((integer8 *) (*s_objet_argument_1)
  135:                         .objet))) * ((real8) (*((integer8 *)
  136:                         (*s_objet_argument_2).objet)))) / 100;
  137:             }
  138:             else
  139:             {
  140:                 (*((real8 *) (*s_objet_resultat).objet)) =
  141:                         (((real8) (*((integer8 *) (*s_objet_argument_1)
  142:                         .objet))) * (*((real8 *)
  143:                         (*s_objet_argument_2).objet))) / 100;
  144:             }
  145:         }
  146:         else
  147:         {
  148:             if ((*s_objet_argument_2).type == INT)
  149:             {
  150:                 (*((real8 *) (*s_objet_resultat).objet)) =
  151:                         ((*((real8 *) (*s_objet_argument_1).objet)) * 
  152:                         ((real8) (*((integer8 *) (*s_objet_argument_2)
  153:                         .objet)))) / 100;
  154:             }
  155:             else
  156:             {
  157:                 (*((real8 *) (*s_objet_resultat).objet)) =
  158:                         ((*((real8 *) (*s_objet_argument_1).objet)) * 
  159:                         (*((real8 *) (*s_objet_argument_2).objet))) / 100;
  160:             }
  161:         }
  162:     }
  163: 
  164: /*
  165: --------------------------------------------------------------------------------
  166:    % entre des arguments complexes
  167: --------------------------------------------------------------------------------
  168: */
  169: 
  170:     /*
  171:      * Nom ou valeur numérique / Nom ou valeur numérique
  172:      */
  173: 
  174:     else if ((((*s_objet_argument_1).type == NOM) &&
  175:             (((*s_objet_argument_2).type == NOM) ||
  176:             ((*s_objet_argument_2).type == INT) ||
  177:             ((*s_objet_argument_2).type == REL))) ||
  178:             (((*s_objet_argument_2).type == NOM) &&
  179:             (((*s_objet_argument_1).type == INT) ||
  180:             ((*s_objet_argument_1).type == REL))))
  181:     {
  182:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
  183:                 == NULL)
  184:         {
  185:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  186:             return;
  187:         }
  188: 
  189:         if (((*s_objet_resultat).objet =
  190:                 allocation_maillon(s_etat_processus)) == NULL)
  191:         {
  192:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  193:             return;
  194:         }
  195: 
  196:         l_element_courant = (*s_objet_resultat).objet;
  197: 
  198:         if (((*l_element_courant).donnee = allocation(s_etat_processus,
  199:                 FCT)) == NULL)
  200:         {
  201:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  202:             return;
  203:         }
  204: 
  205:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  206:                 .nombre_arguments = 0;
  207:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  208:                 .fonction = instruction_vers_niveau_superieur;
  209: 
  210:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  211:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  212:         {
  213:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  214:             return;
  215:         }
  216: 
  217:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  218:                 .nom_fonction, "<<");
  219: 
  220:         if (((*l_element_courant).suivant =
  221:                 allocation_maillon(s_etat_processus)) == NULL)
  222:         {
  223:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  224:             return;
  225:         }
  226: 
  227:         l_element_courant = (*l_element_courant).suivant;
  228:         (*l_element_courant).donnee = s_objet_argument_2;
  229: 
  230:         if (((*l_element_courant).suivant =
  231:                 allocation_maillon(s_etat_processus)) == NULL)
  232:         {
  233:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  234:             return;
  235:         }
  236: 
  237:         l_element_courant = (*l_element_courant).suivant;
  238:         (*l_element_courant).donnee = s_objet_argument_1;
  239: 
  240:         if (((*l_element_courant).suivant =
  241:                 allocation_maillon(s_etat_processus)) == NULL)
  242:         {
  243:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  244:             return;
  245:         }
  246: 
  247:         l_element_courant = (*l_element_courant).suivant;
  248: 
  249:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  250:                 == NULL)
  251:         {
  252:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  253:             return;
  254:         }
  255: 
  256:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  257:                 .nombre_arguments = 2;
  258:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  259:                 .fonction = instruction_pourcent;
  260: 
  261:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  262:                 .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
  263:         {
  264:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  265:             return;
  266:         }
  267: 
  268:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  269:                 .nom_fonction, "%");
  270: 
  271:         if (((*l_element_courant).suivant =
  272:                 allocation_maillon(s_etat_processus)) == NULL)
  273:         {
  274:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  275:             return;
  276:         }
  277: 
  278:         l_element_courant = (*l_element_courant).suivant;
  279: 
  280:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  281:                 == NULL)
  282:         {
  283:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  284:             return;
  285:         }
  286: 
  287:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  288:                 .nombre_arguments = 0;
  289:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  290:                 .fonction = instruction_vers_niveau_inferieur;
  291: 
  292:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  293:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  294:         {
  295:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  296:             return;
  297:         }
  298: 
  299:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  300:                 .nom_fonction, ">>");
  301: 
  302:         (*l_element_courant).suivant = NULL;
  303: 
  304:         s_objet_argument_1 = NULL;
  305:         s_objet_argument_2 = NULL;
  306:     }
  307: 
  308:     /*
  309:      * Nom ou valeur numérique / Expression
  310:      */
  311: 
  312:     else if (((((*s_objet_argument_1).type == ALG) ||
  313:             ((*s_objet_argument_1).type == RPN))) &&
  314:             (((*s_objet_argument_2).type == NOM) ||
  315:             ((*s_objet_argument_2).type == INT) ||
  316:             ((*s_objet_argument_2).type == REL)))
  317:     {
  318:         nombre_elements = 0;
  319:         l_element_courant = (struct_liste_chainee *)
  320:                 (*s_objet_argument_1).objet;
  321: 
  322:         while(l_element_courant != NULL)
  323:         {
  324:             nombre_elements++;
  325:             l_element_courant = (*l_element_courant).suivant;
  326:         }
  327: 
  328:         if (nombre_elements == 2)
  329:         {
  330:             liberation(s_etat_processus, s_objet_argument_1);
  331:             liberation(s_etat_processus, s_objet_argument_2);
  332: 
  333:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  334:             return;
  335:         }
  336: 
  337:         if ((s_objet_resultat = copie_objet(s_etat_processus,
  338:                 s_objet_argument_1, 'N')) == NULL)
  339:         {
  340:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  341:             return;
  342:         }
  343: 
  344:         l_element_courant = (struct_liste_chainee *)
  345:                 (*s_objet_resultat).objet;
  346:         l_element_precedent = l_element_courant;
  347:         l_element_courant = (*l_element_courant).suivant;
  348: 
  349:         if (((*l_element_precedent).suivant =
  350:                 allocation_maillon(s_etat_processus)) == NULL)
  351:         {
  352:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  353:             return;
  354:         }
  355: 
  356:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
  357:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  358: 
  359:         while((*l_element_courant).suivant != NULL)
  360:         {
  361:             l_element_precedent = l_element_courant;
  362:             l_element_courant = (*l_element_courant).suivant;
  363:         }
  364: 
  365:         if (((*l_element_precedent).suivant =
  366:                 allocation_maillon(s_etat_processus)) == NULL)
  367:         {
  368:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  369:             return;
  370:         }
  371: 
  372:         if (((*(*l_element_precedent).suivant).donnee =
  373:                 allocation(s_etat_processus, FCT)) == NULL)
  374:         {
  375:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  376:             return;
  377:         }
  378: 
  379:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  380:                 .donnee).objet)).nombre_arguments = 2;
  381:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  382:                 .donnee).objet)).fonction = instruction_pourcent;
  383: 
  384:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
  385:                 .suivant).donnee).objet)).nom_fonction =
  386:                 malloc(2 * sizeof(unsigned char))) == NULL)
  387:         {
  388:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  389:             return;
  390:         }
  391: 
  392:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
  393:                 .suivant).donnee).objet)).nom_fonction, "%");
  394: 
  395:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  396: 
  397:         s_objet_argument_2 = NULL;
  398:     }
  399: 
  400:     /*
  401:      * Expression / Nom ou valeur numérique
  402:      */
  403: 
  404:     else if ((((*s_objet_argument_1).type == NOM) ||
  405:             ((*s_objet_argument_1).type == INT) ||
  406:             ((*s_objet_argument_1).type == REL)) &&
  407:             ((((*s_objet_argument_2).type == ALG) ||
  408:             ((*s_objet_argument_2).type == RPN))))
  409:     {
  410:         nombre_elements = 0;
  411:         l_element_courant = (struct_liste_chainee *)
  412:                 (*s_objet_argument_2).objet;
  413: 
  414:         while(l_element_courant != NULL)
  415:         {
  416:             nombre_elements++;
  417:             l_element_courant = (*l_element_courant).suivant;
  418:         }
  419: 
  420:         if (nombre_elements == 2)
  421:         {
  422:             liberation(s_etat_processus, s_objet_argument_1);
  423:             liberation(s_etat_processus, s_objet_argument_2);
  424: 
  425:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  426:             return;
  427:         }
  428: 
  429:         if ((s_objet_resultat = copie_objet(s_etat_processus,
  430:                 s_objet_argument_2, 'N')) == NULL)
  431:         {
  432:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  433:             return;
  434:         }
  435: 
  436:         l_element_courant = (struct_liste_chainee *)
  437:                 (*s_objet_resultat).objet;
  438:         l_element_precedent = l_element_courant;
  439: 
  440:         while((*l_element_courant).suivant != NULL)
  441:         {
  442:             l_element_precedent = l_element_courant;
  443:             l_element_courant = (*l_element_courant).suivant;
  444:         }
  445: 
  446:         if (((*l_element_precedent).suivant =
  447:                 allocation_maillon(s_etat_processus)) == NULL)
  448:         {
  449:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  450:             return;
  451:         }
  452: 
  453:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
  454:         l_element_precedent = (*l_element_precedent).suivant;
  455: 
  456:         if (((*l_element_precedent).suivant =
  457:                 allocation_maillon(s_etat_processus)) == NULL)
  458:         {
  459:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  460:             return;
  461:         }
  462: 
  463:         if (((*(*l_element_precedent).suivant).donnee =
  464:                 allocation(s_etat_processus, FCT)) == NULL)
  465:         {
  466:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  467:             return;
  468:         }
  469: 
  470:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  471:                 .donnee).objet)).nombre_arguments = 2;
  472:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  473:                 .donnee).objet)).fonction = instruction_pourcent;
  474: 
  475:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
  476:                 .suivant).donnee).objet)).nom_fonction =
  477:                 malloc(2 * sizeof(unsigned char))) == NULL)
  478:         {
  479:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  480:             return;
  481:         }
  482: 
  483:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
  484:                 .suivant).donnee).objet)).nom_fonction, "%");
  485: 
  486:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  487: 
  488:         s_objet_argument_1 = NULL;
  489:     }
  490: 
  491:     /*
  492:      * Expression / Expression
  493:      */
  494: 
  495:     else if ((((*s_objet_argument_1).type == ALG) &&
  496:             ((*s_objet_argument_2).type == ALG)) ||
  497:             (((*s_objet_argument_1).type == RPN) &&
  498:             ((*s_objet_argument_2).type == RPN)))
  499:     {
  500:         nombre_elements = 0;
  501:         l_element_courant = (struct_liste_chainee *)
  502:                 (*s_objet_argument_1).objet;
  503: 
  504:         while(l_element_courant != NULL)
  505:         {
  506:             nombre_elements++;
  507:             l_element_courant = (*l_element_courant).suivant;
  508:         }
  509: 
  510:         if (nombre_elements == 2)
  511:         {
  512:             liberation(s_etat_processus, s_objet_argument_1);
  513:             liberation(s_etat_processus, s_objet_argument_2);
  514: 
  515:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  516:             return;
  517:         }
  518: 
  519:         nombre_elements = 0;
  520:         l_element_courant = (struct_liste_chainee *)
  521:                 (*s_objet_argument_2).objet;
  522: 
  523:         while(l_element_courant != NULL)
  524:         {
  525:             nombre_elements++;
  526:             l_element_courant = (*l_element_courant).suivant;
  527:         }
  528: 
  529:         if (nombre_elements == 2)
  530:         {
  531:             liberation(s_etat_processus, s_objet_argument_1);
  532:             liberation(s_etat_processus, s_objet_argument_2);
  533: 
  534:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  535:             return;
  536:         }
  537: 
  538:         if ((s_copie_argument_1 = copie_objet(s_etat_processus,
  539:                 s_objet_argument_1, 'N')) == NULL)
  540:         {
  541:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  542:             return;
  543:         }
  544: 
  545:         if ((s_copie_argument_2 = copie_objet(s_etat_processus,
  546:                 s_objet_argument_2, 'N')) == NULL)
  547:         {
  548:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  549:             return;
  550:         }
  551: 
  552:         l_element_courant = (struct_liste_chainee *)
  553:                 (*s_copie_argument_1).objet;
  554:         (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
  555:                 (*s_copie_argument_1).objet)).suivant;
  556: 
  557:         liberation(s_etat_processus, (*l_element_courant).donnee);
  558:         free(l_element_courant);
  559: 
  560:         l_element_courant = (struct_liste_chainee *)
  561:                 (*s_copie_argument_2).objet;
  562:         l_element_precedent = l_element_courant;
  563:         s_objet_resultat = s_copie_argument_2;
  564: 
  565:         while((*l_element_courant).suivant != NULL)
  566:         {
  567:             l_element_precedent = l_element_courant;
  568:             l_element_courant = (*l_element_courant).suivant;
  569:         }
  570: 
  571:         liberation(s_etat_processus, (*l_element_courant).donnee);
  572:         free(l_element_courant);
  573: 
  574:         (*l_element_precedent).suivant = (struct_liste_chainee *)
  575:                 (*s_copie_argument_1).objet;
  576:         free(s_copie_argument_1);
  577: 
  578:         l_element_courant = (*l_element_precedent).suivant;
  579:         while((*l_element_courant).suivant != NULL)
  580:         {
  581:             l_element_precedent = l_element_courant;
  582:             l_element_courant = (*l_element_courant).suivant;
  583:         }
  584: 
  585:         if (((*l_element_precedent).suivant =
  586:                 allocation_maillon(s_etat_processus)) == NULL)
  587:         {
  588:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  589:             return;
  590:         }
  591: 
  592:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  593:         l_element_courant = (*l_element_precedent).suivant;
  594: 
  595:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  596:                 == NULL)
  597:         {
  598:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  599:             return;
  600:         }
  601: 
  602:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  603:                 .nombre_arguments = 2;
  604:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  605:                 .fonction = instruction_pourcent;
  606: 
  607:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  608:                 .nom_fonction = malloc(2 * sizeof(unsigned char))) == NULL)
  609:         {
  610:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  611:             return;
  612:         }
  613: 
  614:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  615:                 .nom_fonction, "%");
  616:     }
  617: 
  618: /*
  619: --------------------------------------------------------------------------------
  620:   Arguments incorrects
  621: --------------------------------------------------------------------------------
  622: */
  623: 
  624:     else
  625:     {
  626:         liberation(s_etat_processus, s_objet_argument_1);
  627:         liberation(s_etat_processus, s_objet_argument_2);
  628: 
  629:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  630:         return;
  631:     }
  632: 
  633:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  634:             s_objet_resultat) == d_erreur)
  635:     {
  636:         return;
  637:     }
  638: 
  639:     liberation(s_etat_processus, s_objet_argument_1);
  640:     liberation(s_etat_processus, s_objet_argument_2);
  641: 
  642:     return;
  643: }
  644: 
  645: 
  646: /*
  647: ================================================================================
  648:   Fonction '%CH'
  649: ================================================================================
  650:   Entrées :
  651: --------------------------------------------------------------------------------
  652:   Sorties :
  653: --------------------------------------------------------------------------------
  654:   Effets de bord : néant
  655: ================================================================================
  656: */
  657: 
  658: void
  659: instruction_pourcent_ch(struct_processus *s_etat_processus)
  660: {
  661:     struct_liste_chainee        *l_element_courant;
  662:     struct_liste_chainee        *l_element_precedent;
  663: 
  664:     struct_objet                *s_copie_argument_1;
  665:     struct_objet                *s_copie_argument_2;
  666:     struct_objet                *s_objet_argument_1;
  667:     struct_objet                *s_objet_argument_2;
  668:     struct_objet                *s_objet_resultat;
  669: 
  670:     integer8                    nombre_elements;
  671: 
  672:     (*s_etat_processus).erreur_execution = d_ex;
  673: 
  674:     if ((*s_etat_processus).affichage_arguments == 'Y')
  675:     {
  676:         printf("\n  %%CH ");
  677: 
  678:         if ((*s_etat_processus).langue == 'F')
  679:         {
  680:             printf("(différence en pourcent)\n\n");
  681:         }
  682:         else
  683:         {
  684:             printf("(change percentage)\n\n");
  685:         }
  686: 
  687:         printf("    2: %s, %s\n", d_INT, d_REL);
  688:         printf("    1: %s, %s\n", d_INT, d_REL);
  689:         printf("->  1: %s\n\n", d_REL);
  690: 
  691:         printf("    2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
  692:         printf("    1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
  693:         printf("->  1: %s\n\n", d_ALG);
  694: 
  695:         printf("    2: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
  696:         printf("    1: %s, %s, %s, %s\n", d_RPN, d_NOM, d_INT, d_REL);
  697:         printf("->  1: %s\n", d_RPN);
  698: 
  699:         return;
  700:     }
  701:     else if ((*s_etat_processus).test_instruction == 'Y')
  702:     {
  703:         (*s_etat_processus).nombre_arguments = -1;
  704:         return;
  705:     }
  706:     
  707:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  708:     {
  709:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
  710:         {
  711:             return;
  712:         }
  713:     }
  714: 
  715:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  716:             &s_objet_argument_1) == d_erreur)
  717:     {
  718:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  719:         return;
  720:     }
  721: 
  722:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  723:             &s_objet_argument_2) == d_erreur)
  724:     {
  725:         liberation(s_etat_processus, s_objet_argument_1);
  726: 
  727:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  728:         return;
  729:     }
  730: 
  731: /*
  732: --------------------------------------------------------------------------------
  733:   %CH portant sur des valeurs numériques
  734: --------------------------------------------------------------------------------
  735: */
  736: 
  737:     if ((((*s_objet_argument_1).type == INT) ||
  738:             ((*s_objet_argument_1).type == REL)) &&
  739:             (((*s_objet_argument_2).type == INT) ||
  740:             ((*s_objet_argument_2).type == REL)))
  741:     {
  742:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
  743:                 == NULL)
  744:         {
  745:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  746:             return;
  747:         }
  748: 
  749:         if ((*s_objet_argument_1).type == INT)
  750:         {
  751:             if ((*s_objet_argument_2).type == INT)
  752:             {
  753:                 (*((real8 *) (*s_objet_resultat).objet)) = 100 *
  754:                         (((real8) (*((integer8 *) (*s_objet_argument_1)
  755:                         .objet)) - ((real8) (*((integer8 *)
  756:                         (*s_objet_argument_2).objet)))) / ((real8)
  757:                         (*((integer8 *) (*s_objet_argument_2).objet))));
  758:             }
  759:             else
  760:             {
  761:                 (*((real8 *) (*s_objet_resultat).objet)) = 100 *
  762:                         (((real8) (*((integer8 *) (*s_objet_argument_1)
  763:                         .objet)) - (*((real8 *) (*s_objet_argument_2).objet)))
  764:                         / (*((real8 *) (*s_objet_argument_2).objet)));
  765:             }
  766:         }
  767:         else
  768:         {
  769:             if ((*s_objet_argument_2).type == INT)
  770:             {
  771:                 (*((real8 *) (*s_objet_resultat).objet)) = 100 *
  772:                         (((*((real8 *) (*s_objet_argument_1)
  773:                         .objet)) - ((real8) (*((integer8 *)
  774:                         (*s_objet_argument_2).objet)))) / ((real8)
  775:                         (*((integer8 *) (*s_objet_argument_2).objet))));
  776:             }
  777:             else
  778:             {
  779:                 (*((real8 *) (*s_objet_resultat).objet)) = 100 *
  780:                         (((*((real8 *) (*s_objet_argument_1).objet)) -
  781:                         (*((real8 *) (*s_objet_argument_2).objet)))/
  782:                         (*((real8 *) (*s_objet_argument_2).objet)));
  783:             }
  784:         }
  785:     }
  786: 
  787: /*
  788: --------------------------------------------------------------------------------
  789:    %CH entre des arguments complexes
  790: --------------------------------------------------------------------------------
  791: */
  792: 
  793:     /*
  794:      * Nom ou valeur numérique / Nom ou valeur numérique
  795:      */
  796: 
  797:     else if ((((*s_objet_argument_1).type == NOM) &&
  798:             (((*s_objet_argument_2).type == NOM) ||
  799:             ((*s_objet_argument_2).type == INT) ||
  800:             ((*s_objet_argument_2).type == REL))) ||
  801:             (((*s_objet_argument_2).type == NOM) &&
  802:             (((*s_objet_argument_1).type == INT) ||
  803:             ((*s_objet_argument_1).type == REL))))
  804:     {
  805:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
  806:                 == NULL)
  807:         {
  808:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  809:             return;
  810:         }
  811: 
  812:         if (((*s_objet_resultat).objet =
  813:                 allocation_maillon(s_etat_processus)) == NULL)
  814:         {
  815:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  816:             return;
  817:         }
  818: 
  819:         l_element_courant = (*s_objet_resultat).objet;
  820: 
  821:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  822:                 == NULL)
  823:         {
  824:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  825:             return;
  826:         }
  827: 
  828:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  829:                 .nombre_arguments = 0;
  830:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  831:                 .fonction = instruction_vers_niveau_superieur;
  832: 
  833:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  834:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  835:         {
  836:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  837:             return;
  838:         }
  839: 
  840:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  841:                 .nom_fonction, "<<");
  842: 
  843:         if (((*l_element_courant).suivant =
  844:                 allocation_maillon(s_etat_processus)) == NULL)
  845:         {
  846:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  847:             return;
  848:         }
  849: 
  850:         l_element_courant = (*l_element_courant).suivant;
  851:         (*l_element_courant).donnee = s_objet_argument_2;
  852: 
  853:         if (((*l_element_courant).suivant =
  854:                 allocation_maillon(s_etat_processus)) == NULL)
  855:         {
  856:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  857:             return;
  858:         }
  859: 
  860:         l_element_courant = (*l_element_courant).suivant;
  861:         (*l_element_courant).donnee = s_objet_argument_1;
  862: 
  863:         if (((*l_element_courant).suivant =
  864:                 allocation_maillon(s_etat_processus)) == NULL)
  865:         {
  866:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  867:             return;
  868:         }
  869: 
  870:         l_element_courant = (*l_element_courant).suivant;
  871: 
  872:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  873:                 == NULL)
  874:         {
  875:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  876:             return;
  877:         }
  878: 
  879:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  880:                 .nombre_arguments = 2;
  881:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  882:                 .fonction = instruction_pourcent_ch;
  883: 
  884:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  885:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
  886:         {
  887:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  888:             return;
  889:         }
  890: 
  891:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  892:                 .nom_fonction, "%CH");
  893: 
  894:         if (((*l_element_courant).suivant =
  895:                 allocation_maillon(s_etat_processus)) == NULL)
  896:         {
  897:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  898:             return;
  899:         }
  900: 
  901:         l_element_courant = (*l_element_courant).suivant;
  902: 
  903:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  904:                 == NULL)
  905:         {
  906:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  907:             return;
  908:         }
  909: 
  910:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  911:                 .nombre_arguments = 0;
  912:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  913:                 .fonction = instruction_vers_niveau_inferieur;
  914: 
  915:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  916:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  917:         {
  918:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  919:             return;
  920:         }
  921: 
  922:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  923:                 .nom_fonction, ">>");
  924: 
  925:         (*l_element_courant).suivant = NULL;
  926: 
  927:         s_objet_argument_1 = NULL;
  928:         s_objet_argument_2 = NULL;
  929:     }
  930: 
  931:     /*
  932:      * Nom ou valeur numérique / Expression
  933:      */
  934: 
  935:     else if (((((*s_objet_argument_1).type == ALG) ||
  936:             ((*s_objet_argument_1).type == RPN))) &&
  937:             (((*s_objet_argument_2).type == NOM) ||
  938:             ((*s_objet_argument_2).type == INT) ||
  939:             ((*s_objet_argument_2).type == REL)))
  940:     {
  941:         nombre_elements = 0;
  942:         l_element_courant = (struct_liste_chainee *)
  943:                 (*s_objet_argument_1).objet;
  944: 
  945:         while(l_element_courant != NULL)
  946:         {
  947:             nombre_elements++;
  948:             l_element_courant = (*l_element_courant).suivant;
  949:         }
  950: 
  951:         if (nombre_elements == 2)
  952:         {
  953:             liberation(s_etat_processus, s_objet_argument_1);
  954:             liberation(s_etat_processus, s_objet_argument_2);
  955: 
  956:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
  957:             return;
  958:         }
  959: 
  960:         if ((s_objet_resultat = copie_objet(s_etat_processus,
  961:                 s_objet_argument_1, 'N')) == NULL)
  962:         {
  963:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  964:             return;
  965:         }
  966: 
  967:         l_element_courant = (struct_liste_chainee *)
  968:                 (*s_objet_resultat).objet;
  969:         l_element_precedent = l_element_courant;
  970:         l_element_courant = (*l_element_courant).suivant;
  971: 
  972:         if (((*l_element_precedent).suivant =
  973:                 allocation_maillon(s_etat_processus)) == NULL)
  974:         {
  975:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  976:             return;
  977:         }
  978: 
  979:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
  980:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  981: 
  982:         while((*l_element_courant).suivant != NULL)
  983:         {
  984:             l_element_precedent = l_element_courant;
  985:             l_element_courant = (*l_element_courant).suivant;
  986:         }
  987: 
  988:         if (((*l_element_precedent).suivant =
  989:                 allocation_maillon(s_etat_processus)) == NULL)
  990:         {
  991:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  992:             return;
  993:         }
  994: 
  995:         if (((*(*l_element_precedent).suivant).donnee =
  996:                 allocation(s_etat_processus, FCT)) == NULL)
  997:         {
  998:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  999:             return;
 1000:         }
 1001: 
 1002:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1003:                 .donnee).objet)).nombre_arguments = 2;
 1004:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1005:                 .donnee).objet)).fonction = instruction_pourcent_ch;
 1006: 
 1007:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1008:                 .suivant).donnee).objet)).nom_fonction =
 1009:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1010:         {
 1011:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1012:             return;
 1013:         }
 1014: 
 1015:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1016:                 .suivant).donnee).objet)).nom_fonction, "%CH");
 1017: 
 1018:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1019: 
 1020:         s_objet_argument_2 = NULL;
 1021:     }
 1022: 
 1023:     /*
 1024:      * Expression / Nom ou valeur numérique
 1025:      */
 1026: 
 1027:     else if ((((*s_objet_argument_1).type == NOM) ||
 1028:             ((*s_objet_argument_1).type == INT) ||
 1029:             ((*s_objet_argument_1).type == REL)) &&
 1030:             ((((*s_objet_argument_2).type == ALG) ||
 1031:             ((*s_objet_argument_2).type == RPN))))
 1032:     {
 1033:         nombre_elements = 0;
 1034:         l_element_courant = (struct_liste_chainee *)
 1035:                 (*s_objet_argument_2).objet;
 1036: 
 1037:         while(l_element_courant != NULL)
 1038:         {
 1039:             nombre_elements++;
 1040:             l_element_courant = (*l_element_courant).suivant;
 1041:         }
 1042: 
 1043:         if (nombre_elements == 2)
 1044:         {
 1045:             liberation(s_etat_processus, s_objet_argument_1);
 1046:             liberation(s_etat_processus, s_objet_argument_2);
 1047: 
 1048:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1049:             return;
 1050:         }
 1051: 
 1052:         if ((s_objet_resultat = copie_objet(s_etat_processus,
 1053:                 s_objet_argument_2, 'N')) == NULL)
 1054:         {
 1055:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1056:             return;
 1057:         }
 1058: 
 1059:         l_element_courant = (struct_liste_chainee *)
 1060:                 (*s_objet_resultat).objet;
 1061:         l_element_precedent = l_element_courant;
 1062: 
 1063:         while((*l_element_courant).suivant != NULL)
 1064:         {
 1065:             l_element_precedent = l_element_courant;
 1066:             l_element_courant = (*l_element_courant).suivant;
 1067:         }
 1068: 
 1069:         if (((*l_element_precedent).suivant =
 1070:                 allocation_maillon(s_etat_processus)) == NULL)
 1071:         {
 1072:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1073:             return;
 1074:         }
 1075: 
 1076:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
 1077:         l_element_precedent = (*l_element_precedent).suivant;
 1078: 
 1079:         if (((*l_element_precedent).suivant =
 1080:                 allocation_maillon(s_etat_processus)) == NULL)
 1081:         {
 1082:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1083:             return;
 1084:         }
 1085: 
 1086:         if (((*(*l_element_precedent).suivant).donnee =
 1087:                 allocation(s_etat_processus, FCT)) == NULL)
 1088:         {
 1089:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1090:             return;
 1091:         }
 1092: 
 1093:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1094:                 .donnee).objet)).nombre_arguments = 2;
 1095:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1096:                 .donnee).objet)).fonction = instruction_pourcent_ch;
 1097: 
 1098:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1099:                 .suivant).donnee).objet)).nom_fonction =
 1100:                 malloc(4 * sizeof(unsigned char))) == NULL)
 1101:         {
 1102:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1103:             return;
 1104:         }
 1105: 
 1106:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1107:                 .suivant).donnee).objet)).nom_fonction, "%CH");
 1108: 
 1109:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1110: 
 1111:         s_objet_argument_1 = NULL;
 1112:     }
 1113: 
 1114:     /*
 1115:      * Expression / Expression
 1116:      */
 1117: 
 1118:     else if ((((*s_objet_argument_1).type == ALG) &&
 1119:             ((*s_objet_argument_2).type == ALG)) ||
 1120:             (((*s_objet_argument_1).type == RPN) &&
 1121:             ((*s_objet_argument_2).type == RPN)))
 1122:     {
 1123:         nombre_elements = 0;
 1124:         l_element_courant = (struct_liste_chainee *)
 1125:                 (*s_objet_argument_1).objet;
 1126: 
 1127:         while(l_element_courant != NULL)
 1128:         {
 1129:             nombre_elements++;
 1130:             l_element_courant = (*l_element_courant).suivant;
 1131:         }
 1132: 
 1133:         if (nombre_elements == 2)
 1134:         {
 1135:             liberation(s_etat_processus, s_objet_argument_1);
 1136:             liberation(s_etat_processus, s_objet_argument_2);
 1137: 
 1138:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1139:             return;
 1140:         }
 1141: 
 1142:         nombre_elements = 0;
 1143:         l_element_courant = (struct_liste_chainee *)
 1144:                 (*s_objet_argument_2).objet;
 1145: 
 1146:         while(l_element_courant != NULL)
 1147:         {
 1148:             nombre_elements++;
 1149:             l_element_courant = (*l_element_courant).suivant;
 1150:         }
 1151: 
 1152:         if (nombre_elements == 2)
 1153:         {
 1154:             liberation(s_etat_processus, s_objet_argument_1);
 1155:             liberation(s_etat_processus, s_objet_argument_2);
 1156: 
 1157:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 1158:             return;
 1159:         }
 1160: 
 1161:         if ((s_copie_argument_1 = copie_objet(s_etat_processus,
 1162:                 s_objet_argument_1, 'N')) == NULL)
 1163:         {
 1164:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1165:             return;
 1166:         }
 1167: 
 1168:         if ((s_copie_argument_2 = copie_objet(s_etat_processus,
 1169:                 s_objet_argument_2, 'N')) == NULL)
 1170:         {
 1171:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1172:             return;
 1173:         }
 1174: 
 1175:         l_element_courant = (struct_liste_chainee *)
 1176:                 (*s_copie_argument_1).objet;
 1177:         (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
 1178:                 (*s_copie_argument_1).objet)).suivant;
 1179: 
 1180:         liberation(s_etat_processus, (*l_element_courant).donnee);
 1181:         free(l_element_courant);
 1182: 
 1183:         l_element_courant = (struct_liste_chainee *)
 1184:                 (*s_copie_argument_2).objet;
 1185:         l_element_precedent = l_element_courant;
 1186:         s_objet_resultat = s_copie_argument_2;
 1187: 
 1188:         while((*l_element_courant).suivant != NULL)
 1189:         {
 1190:             l_element_precedent = l_element_courant;
 1191:             l_element_courant = (*l_element_courant).suivant;
 1192:         }
 1193: 
 1194:         liberation(s_etat_processus, (*l_element_courant).donnee);
 1195:         free(l_element_courant);
 1196: 
 1197:         (*l_element_precedent).suivant = (struct_liste_chainee *)
 1198:                 (*s_copie_argument_1).objet;
 1199:         free(s_copie_argument_1);
 1200: 
 1201:         l_element_courant = (*l_element_precedent).suivant;
 1202:         while((*l_element_courant).suivant != NULL)
 1203:         {
 1204:             l_element_precedent = l_element_courant;
 1205:             l_element_courant = (*l_element_courant).suivant;
 1206:         }
 1207: 
 1208:         if (((*l_element_precedent).suivant =
 1209:                 allocation_maillon(s_etat_processus)) == NULL)
 1210:         {
 1211:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1212:             return;
 1213:         }
 1214: 
 1215:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1216:         l_element_courant = (*l_element_precedent).suivant;
 1217: 
 1218:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1219:                 == NULL)
 1220:         {
 1221:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1222:             return;
 1223:         }
 1224: 
 1225:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1226:                 .nombre_arguments = 2;
 1227:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1228:                 .fonction = instruction_pourcent_ch;
 1229: 
 1230:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1231:                 .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
 1232:         {
 1233:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1234:             return;
 1235:         }
 1236: 
 1237:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1238:                 .nom_fonction, "%CH");
 1239:     }
 1240: 
 1241: /*
 1242: --------------------------------------------------------------------------------
 1243:   Arguments incorrects
 1244: --------------------------------------------------------------------------------
 1245: */
 1246: 
 1247:     else
 1248:     {
 1249:         liberation(s_etat_processus, s_objet_argument_1);
 1250:         liberation(s_etat_processus, s_objet_argument_2);
 1251: 
 1252:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1253:         return;
 1254:     }
 1255: 
 1256:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1257:             s_objet_resultat) == d_erreur)
 1258:     {
 1259:         return;
 1260:     }
 1261: 
 1262:     liberation(s_etat_processus, s_objet_argument_1);
 1263:     liberation(s_etat_processus, s_objet_argument_2);
 1264: 
 1265:     return;
 1266: }
 1267: 
 1268: 
 1269: /*
 1270: ================================================================================
 1271:   Fonction 'pos'
 1272: ================================================================================
 1273:   Entrées :
 1274: --------------------------------------------------------------------------------
 1275:   Sorties :
 1276: --------------------------------------------------------------------------------
 1277:   Effets de bord : néant
 1278: ================================================================================
 1279: */
 1280: 
 1281: void
 1282: instruction_pos(struct_processus *s_etat_processus)
 1283: {
 1284:     logical1                    presence_atome;
 1285: 
 1286:     struct_liste_chainee        *l_base_pile;
 1287:     struct_liste_chainee        *l_element_courant;
 1288: 
 1289:     struct_objet                *s_objet_argument_1;
 1290:     struct_objet                *s_objet_argument_2;
 1291:     struct_objet                *s_objet_elementaire;
 1292:     struct_objet                *s_objet_resultat;
 1293: 
 1294:     unsigned char               *pointeur_occurrence;
 1295: 
 1296:     integer8                    position;
 1297: 
 1298:     (*s_etat_processus).erreur_execution = d_ex;
 1299: 
 1300:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1301:     {
 1302:         printf("\n  POS ");
 1303: 
 1304:         if ((*s_etat_processus).langue == 'F')
 1305:         {
 1306:             printf("(position)\n\n");
 1307:         }
 1308:         else
 1309:         {
 1310:             printf("(position)\n\n");
 1311:         }
 1312: 
 1313:         printf("    2: %s\n", d_CHN);
 1314:         printf("    1: %s\n", d_CHN);
 1315:         printf("->  1: %s\n\n", d_INT);
 1316: 
 1317:         printf("    2: %s, %s\n", d_LST, d_TAB);
 1318:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
 1319:                 "       %s, %s, %s, %s, %s,\n"
 1320:                 "       %s, %s, %s, %s\n",
 1321:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 1322:                 d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
 1323:         printf("->  1: %s\n", d_INT);
 1324: 
 1325:         return;
 1326:     }
 1327:     else if ((*s_etat_processus).test_instruction == 'Y')
 1328:     {
 1329:         (*s_etat_processus).nombre_arguments = -1;
 1330:         return;
 1331:     }
 1332:     
 1333:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1334:     {
 1335:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 1336:         {
 1337:             return;
 1338:         }
 1339:     }
 1340: 
 1341:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1342:             &s_objet_argument_1) == d_erreur)
 1343:     {
 1344:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1345:         return;
 1346:     }
 1347: 
 1348:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1349:             &s_objet_argument_2) == d_erreur)
 1350:     {
 1351:         liberation(s_etat_processus, s_objet_argument_1);
 1352: 
 1353:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1354:         return;
 1355:     }
 1356: 
 1357: /*
 1358: --------------------------------------------------------------------------------
 1359:   Types chaînes de caractères
 1360: --------------------------------------------------------------------------------
 1361: */
 1362: 
 1363:     if (((*s_objet_argument_1).type == CHN) &&
 1364:             ((*s_objet_argument_2).type == CHN))
 1365:     {
 1366:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1367:         {
 1368:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1369:             return;
 1370:         }
 1371: 
 1372:         if ((pointeur_occurrence = strstr((unsigned char *)
 1373:                 (*s_objet_argument_2).objet, (unsigned char *)
 1374:                 (*s_objet_argument_1).objet)) == NULL)
 1375:         {
 1376:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1377:         }
 1378:         else
 1379:         {
 1380:             (*((integer8 *) (*s_objet_resultat).objet)) =
 1381:                     position_caractere_de_chaine(s_etat_processus,
 1382:                     (unsigned char *) (*s_objet_argument_2).objet,
 1383:                     pointeur_occurrence);
 1384:         }
 1385:     }
 1386: 
 1387: /*
 1388: --------------------------------------------------------------------------------
 1389:   L'argument au niveau 2 est une liste, celui au niveau 1 peut prendre
 1390:   n'importe quel type susceptible d'être contenu dans une liste.
 1391: --------------------------------------------------------------------------------
 1392: */
 1393: 
 1394:     else if ((*s_objet_argument_2).type == LST)
 1395:     {
 1396:         l_element_courant = (struct_liste_chainee *)
 1397:                 (*s_objet_argument_2).objet;
 1398:         position = 1;
 1399:         presence_atome = d_faux;
 1400: 
 1401:         l_base_pile = (*s_etat_processus).l_base_pile_last;
 1402:         (*s_etat_processus).l_base_pile_last = NULL;
 1403:         
 1404:         while(l_element_courant != NULL)
 1405:         {
 1406:             if ((s_objet_elementaire =
 1407:                     copie_objet(s_etat_processus, (*l_element_courant).donnee,
 1408:                     'P')) == NULL)
 1409:             {
 1410:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1411:                 return;
 1412:             }
 1413: 
 1414:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1415:                     s_objet_elementaire) == d_erreur)
 1416:             {
 1417:                 return;
 1418:             }
 1419: 
 1420:             if ((s_objet_elementaire =
 1421:                     copie_objet(s_etat_processus, s_objet_argument_1, 'P'))
 1422:                     == NULL)
 1423:             {
 1424:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1425:                 return;
 1426:             }
 1427: 
 1428:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1429:                     s_objet_elementaire) == d_erreur)
 1430:             {
 1431:                 return;
 1432:             }
 1433: 
 1434:             instruction_same(s_etat_processus);
 1435: 
 1436:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1437:                     &s_objet_elementaire) == d_erreur)
 1438:             {
 1439:                 (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1440:                 return;
 1441:             }
 1442: 
 1443:             if ((*s_objet_elementaire).type == INT)
 1444:             {
 1445:                 if ((*((integer8 *)  (*s_objet_elementaire).objet)) != 0)
 1446:                 {
 1447:                     presence_atome = d_vrai;
 1448: 
 1449:                     liberation(s_etat_processus, s_objet_elementaire);
 1450:                     break;
 1451:                 }
 1452:             }
 1453:             else
 1454:             {
 1455:                 (*s_etat_processus).erreur_execution =
 1456:                         d_ex_erreur_type_argument;
 1457:                 return;
 1458:             }
 1459: 
 1460:             liberation(s_etat_processus, s_objet_elementaire);
 1461: 
 1462:             l_element_courant = (*l_element_courant).suivant;
 1463:             position++;
 1464:         }
 1465: 
 1466:         if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1467:         {
 1468:             if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1469:             {
 1470:                 return;
 1471:             }
 1472:         }
 1473: 
 1474:         (*s_etat_processus).l_base_pile_last = l_base_pile;
 1475: 
 1476:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1477:         {
 1478:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1479:             return;
 1480:         }
 1481: 
 1482:         if (presence_atome == d_faux)
 1483:         {
 1484:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1485:         }
 1486:         else
 1487:         {
 1488:             (*((integer8 *) (*s_objet_resultat).objet)) = position;
 1489:         }
 1490:     }
 1491: 
 1492: /*
 1493: --------------------------------------------------------------------------------
 1494:   L'argument au niveau 2 est une table, celui au niveau 1 peut prendre
 1495:   n'importe quel type susceptible d'être contenu dans une liste.
 1496: --------------------------------------------------------------------------------
 1497: */
 1498: 
 1499:     else if ((*s_objet_argument_2).type == TBL)
 1500:     {
 1501:         presence_atome = d_faux;
 1502: 
 1503:         l_base_pile = (*s_etat_processus).l_base_pile_last;
 1504:         (*s_etat_processus).l_base_pile_last = NULL;
 1505:         
 1506:         position = 0;
 1507: 
 1508:         do
 1509:         {
 1510:             if ((s_objet_elementaire =
 1511:                     copie_objet(s_etat_processus, (*((struct_tableau *)
 1512:                     (*s_objet_argument_2) .objet)).elements[position], 'P'))
 1513:                     == NULL)
 1514:             {
 1515:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1516:                 return;
 1517:             }
 1518: 
 1519:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1520:                     s_objet_elementaire) == d_erreur)
 1521:             {
 1522:                 return;
 1523:             }
 1524: 
 1525:             if ((s_objet_elementaire = copie_objet(s_etat_processus,
 1526:                     s_objet_argument_1, 'P')) == NULL)
 1527:             {
 1528:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1529:                 return;
 1530:             }
 1531: 
 1532:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1533:                     s_objet_elementaire) == d_erreur)
 1534:             {
 1535:                 return;
 1536:             }
 1537: 
 1538:             instruction_same(s_etat_processus);
 1539: 
 1540:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1541:                     &s_objet_elementaire) == d_erreur)
 1542:             {
 1543:                 (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1544:                 return;
 1545:             }
 1546: 
 1547:             if ((*s_objet_elementaire).type == INT)
 1548:             {
 1549:                 if ((*((integer8 *)  (*s_objet_elementaire).objet)) != 0)
 1550:                 {
 1551:                     presence_atome = d_vrai;
 1552:                     position++;
 1553: 
 1554:                     liberation(s_etat_processus, s_objet_elementaire);
 1555:                     break;
 1556:                 }
 1557:             }
 1558:             else
 1559:             {
 1560:                 (*s_etat_processus).erreur_execution =
 1561:                         d_ex_erreur_type_argument;
 1562:                 return;
 1563:             }
 1564: 
 1565:             liberation(s_etat_processus, s_objet_elementaire);
 1566: 
 1567:             position++;
 1568:         } while(position < (*((struct_tableau *) (*s_objet_argument_2).objet))
 1569:                 .nombre_elements);
 1570: 
 1571:         if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1572:         {
 1573:             if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 1574:             {
 1575:                 return;
 1576:             }
 1577:         }
 1578: 
 1579:         (*s_etat_processus).l_base_pile_last = l_base_pile;
 1580: 
 1581:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1582:         {
 1583:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1584:             return;
 1585:         }
 1586: 
 1587:         if (presence_atome == d_faux)
 1588:         {
 1589:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1590:         }
 1591:         else
 1592:         {
 1593:             (*((integer8 *) (*s_objet_resultat).objet)) = position;
 1594:         }
 1595:     }
 1596: 
 1597: /*
 1598: --------------------------------------------------------------------------------
 1599:   Arguments invalides
 1600: --------------------------------------------------------------------------------
 1601: */
 1602: 
 1603:     else
 1604:     {
 1605:         liberation(s_etat_processus, s_objet_argument_1);
 1606:         liberation(s_etat_processus, s_objet_argument_2);
 1607: 
 1608:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1609:         return;
 1610:     }
 1611: 
 1612:     liberation(s_etat_processus, s_objet_argument_1);
 1613:     liberation(s_etat_processus, s_objet_argument_2);
 1614: 
 1615:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1616:             s_objet_resultat) == d_erreur)
 1617:     {
 1618:         return;
 1619:     }
 1620: 
 1621:     return;
 1622: }
 1623: 
 1624: 
 1625: /*
 1626: ================================================================================
 1627:   Fonction 'prompt'
 1628: ================================================================================
 1629:   Entrées :
 1630: --------------------------------------------------------------------------------
 1631:   Sorties :
 1632: --------------------------------------------------------------------------------
 1633:   Effets de bord : néant
 1634: ================================================================================
 1635: */
 1636: 
 1637: void
 1638: instruction_prompt(struct_processus *s_etat_processus)
 1639: {
 1640:     struct_objet                *s_objet_argument;
 1641:     struct_objet                *s_objet_resultat;
 1642: 
 1643:     unsigned char               *ptr_e;
 1644:     unsigned char               *ptr_l;
 1645:     unsigned char               *tampon;
 1646:     unsigned char               *tampon2;
 1647: 
 1648:     integer8                    i;
 1649: 
 1650:     (*s_etat_processus).erreur_execution = d_ex;
 1651: 
 1652:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1653:     {
 1654:         printf("\n  PROMPT ");
 1655: 
 1656:         if ((*s_etat_processus).langue == 'F')
 1657:         {
 1658:             printf("(attente d'une entrée)\n\n");
 1659:         }
 1660:         else
 1661:         {
 1662:             printf("(prompt)\n\n");
 1663:         }
 1664: 
 1665:         printf("    1: %s\n", d_CHN);
 1666:         printf("->  1: %s\n", d_CHN);
 1667: 
 1668:         return;
 1669:     }
 1670:     else if ((*s_etat_processus).test_instruction == 'Y')
 1671:     {
 1672:         (*s_etat_processus).nombre_arguments = -1;
 1673:         return;
 1674:     }
 1675:     
 1676:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1677:     {
 1678:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 1679:         {
 1680:             return;
 1681:         }
 1682:     }
 1683: 
 1684:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1685:             &s_objet_argument) == d_erreur)
 1686:     {
 1687:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1688:         return;
 1689:     }
 1690: 
 1691:     if ((*s_objet_argument).type == CHN)
 1692:     {
 1693:         if ((tampon = formateur(s_etat_processus, 0, s_objet_argument)) == NULL)
 1694:         {
 1695:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1696:             return;
 1697:         }
 1698: 
 1699:         if ((tampon2 = transliteration(s_etat_processus, tampon,
 1700:                 d_locale, (*s_etat_processus).localisation)) == NULL)
 1701:         {
 1702:             free(tampon);
 1703: 
 1704:             (*s_etat_processus).erreur_execution = d_ex_erreur_transcodage;
 1705:             return;
 1706:         }
 1707: 
 1708:         free(tampon);
 1709: 
 1710:         if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
 1711:         {
 1712:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1713:             return;
 1714:         }
 1715: 
 1716:         flockfile(stdin);
 1717:         flockfile(stdout);
 1718: 
 1719:         (*s_objet_resultat).objet = (void *) readline(tampon2);
 1720: 
 1721:         funlockfile(stdin);
 1722:         funlockfile(stdout);
 1723: 
 1724:         free(tampon2);
 1725: 
 1726:         if ((*s_objet_resultat).objet == NULL)
 1727:         {
 1728:             if (((*s_objet_resultat).objet = malloc(sizeof(unsigned char)))
 1729:                     == NULL)
 1730:             {
 1731:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1732:                 return;
 1733:             }
 1734: 
 1735:             (*((unsigned char *) (*s_objet_resultat).objet)) =
 1736:                     d_code_fin_chaine;
 1737:         }
 1738: 
 1739:         if ((tampon = transliteration(s_etat_processus,
 1740:                 (unsigned char *) (*s_objet_resultat).objet,
 1741:                 (*s_etat_processus).localisation, d_locale)) == NULL)
 1742:         {
 1743:             return;
 1744:         }
 1745: 
 1746:         free((unsigned char *) (*s_objet_resultat).objet);
 1747: 
 1748:         ptr_l = tampon;
 1749:         i = 0;
 1750: 
 1751:         while((*ptr_l) != d_code_fin_chaine)
 1752:         {
 1753:             if ((*ptr_l) == '\"')
 1754:             {
 1755:                 i++;
 1756:             }
 1757: 
 1758:             ptr_l++;
 1759:         }
 1760: 
 1761:         if ((tampon2 = malloc((strlen(tampon) + 1 + ((size_t) i)) *
 1762:                 sizeof(unsigned char))) == NULL)
 1763:         {
 1764:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1765:             return;
 1766:         }
 1767: 
 1768:         ptr_l = tampon;
 1769:         ptr_e = tampon2;
 1770: 
 1771:         while((*ptr_l) != d_code_fin_chaine)
 1772:         {
 1773:             if ((*ptr_l) == '\"')
 1774:             {
 1775:                 (*ptr_e) = '\\';
 1776:                 ptr_e++;
 1777:             }
 1778: 
 1779:             (*ptr_e) = (*ptr_l);
 1780:             ptr_e++;
 1781:             ptr_l++;
 1782:         }
 1783: 
 1784:         free(tampon);
 1785:         (*s_objet_resultat).objet = tampon2;
 1786: 
 1787:         add_history((unsigned char *) (*s_objet_resultat).objet);
 1788:         stifle_history(ds_longueur_historique);
 1789:     }
 1790:     else
 1791:     {
 1792:         liberation(s_etat_processus, s_objet_argument);
 1793: 
 1794:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1795:         return;
 1796:     }
 1797: 
 1798:     liberation(s_etat_processus, s_objet_argument);
 1799: 
 1800:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1801:             s_objet_resultat) == d_erreur)
 1802:     {
 1803:         return;
 1804:     }
 1805: 
 1806:     return;
 1807: }
 1808: 
 1809: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>