File:  [local] / rpl / src / instructions_s1.c
Revision 1.23.2.3: download - view: text, annotated - select for diffs - revision graph
Wed Apr 13 17:43:14 2011 UTC (13 years ago) by bertrand
Branches: rpl-4_0
CVS tags: rpl-4_0_22
Diff to: branchpoint 1.23: preferred, colored
"NONE" IMPLICIT interdit la manipulation des variables globales par STO.

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.22
    4:   Copyright (C) 1989-2011 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 'swap'
   29: ================================================================================
   30:   Entrées : structure processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_swap(struct_processus *s_etat_processus)
   40: {
   41:     struct_liste_chainee                    *l_liste;
   42: 
   43:     (*s_etat_processus).erreur_execution = d_ex;
   44: 
   45:     if ((*s_etat_processus).affichage_arguments == 'Y')
   46:     {
   47:         printf("\n  SWAP ");
   48: 
   49:         if ((*s_etat_processus).langue == 'F')
   50:         {
   51:             printf("(inversion de deux objets)\n\n");
   52:         }
   53:         else
   54:         {
   55:             printf("(swap two objects)\n\n");
   56:         }
   57: 
   58:         printf("    2: %s, %s, %s, %s, %s, %s,\n"
   59:                 "       %s, %s, %s, %s, %s,\n"
   60:                 "       %s, %s, %s, %s, %s,\n"
   61:                 "       %s, %s, %s, %s, %s,\n"
   62:                 "       %s\n",
   63:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
   64:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
   65:                 d_SLB, d_PRC, d_MTX, d_SQL);
   66:         printf("    1: %s, %s, %s, %s, %s, %s,\n"
   67:                 "       %s, %s, %s, %s, %s,\n"
   68:                 "       %s, %s, %s, %s, %s,\n"
   69:                 "       %s, %s, %s, %s, %s,\n"
   70:                 "       %s\n",
   71:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
   72:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
   73:                 d_SLB, d_PRC, d_MTX, d_SQL);
   74:         printf("->  2: %s, %s, %s, %s, %s, %s,\n"
   75:                 "       %s, %s, %s, %s, %s,\n"
   76:                 "       %s, %s, %s, %s, %s,\n"
   77:                 "       %s, %s, %s, %s, %s,\n"
   78:                 "       %s\n",
   79:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
   80:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
   81:                 d_SLB, d_PRC, d_MTX, d_SQL);
   82:         printf("    1: %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, %s,\n"
   86:                 "       %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_SLB, d_PRC, d_MTX, d_SQL);
   90: 
   91:         return;
   92:     }
   93:     else if ((*s_etat_processus).test_instruction == 'Y')
   94:     {
   95:         (*s_etat_processus).nombre_arguments = -1;
   96:         return;
   97:     }
   98: 
   99:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  100:     {
  101:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
  102:         {
  103:             return;
  104:         }
  105:     }
  106: 
  107:     if ((*s_etat_processus).hauteur_pile_operationnelle < 2)
  108:     {
  109:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  110:         return;
  111:     }
  112: 
  113:     l_liste = (*s_etat_processus).l_base_pile;
  114:     (*s_etat_processus).l_base_pile = (*l_liste).suivant;
  115:     (*l_liste).suivant = (*(*s_etat_processus).l_base_pile).suivant;
  116:     (*(*s_etat_processus).l_base_pile).suivant = l_liste;
  117: 
  118:     return;
  119: }
  120: 
  121: 
  122: /*
  123: ================================================================================
  124:   Fonction 'sq'
  125: ================================================================================
  126:   Entrées : pointeur sur une struct_processus
  127: --------------------------------------------------------------------------------
  128:   Sorties :
  129: --------------------------------------------------------------------------------
  130:   Effets de bord : néant
  131: ================================================================================
  132: */
  133: 
  134: void
  135: instruction_sq(struct_processus *s_etat_processus)
  136: {
  137:     integer8                        a;
  138:     integer8                        r;
  139: 
  140:     logical1                        depassement;
  141:     logical1                        erreur_memoire;
  142: 
  143:     struct_liste_chainee            *l_element_courant;
  144:     struct_liste_chainee            *l_element_precedent;
  145: 
  146:     struct_objet                    *s_copie_argument;
  147:     struct_objet                    *s_objet_argument;
  148:     struct_objet                    *s_objet_resultat;
  149: 
  150:     unsigned long                   i;
  151:     unsigned long                   j;
  152:     unsigned long                   k;
  153: 
  154:     void                            *accumulateur;
  155: 
  156:     (*s_etat_processus).erreur_execution = d_ex;
  157: 
  158:     if ((*s_etat_processus).affichage_arguments == 'Y')
  159:     {
  160:         printf("\n  SQ ");
  161: 
  162:         if ((*s_etat_processus).langue == 'F')
  163:         {
  164:             printf("(élevation au carré)\n\n");
  165:         }
  166:         else
  167:         {
  168:             printf("(square)\n\n");
  169:         }
  170: 
  171:         printf("    1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
  172:         printf("->  1: %s, %s, %s\n\n", d_INT, d_REL, d_CPL);
  173: 
  174:         printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
  175:         printf("->  1: %s, %s, %s\n\n", d_MIN, d_MRL, d_MCX);
  176: 
  177:         printf("    1: %s, %s\n", d_NOM, d_ALG);
  178:         printf("->  1: %s\n\n", d_ALG);
  179: 
  180:         printf("    1: %s\n", d_RPN);
  181:         printf("->  1: %s\n", d_RPN);
  182: 
  183:         return;
  184:     }
  185:     else if ((*s_etat_processus).test_instruction == 'Y')
  186:     {
  187:         (*s_etat_processus).nombre_arguments = 1;
  188:         return;
  189:     }
  190: 
  191:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  192:     {
  193:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  194:         {
  195:             return;
  196:         }
  197:     }
  198: 
  199:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  200:             &s_objet_argument) == d_erreur)
  201:     {
  202:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  203:         return;
  204:     }
  205: 
  206: /*
  207: --------------------------------------------------------------------------------
  208:   Carré d'un entier
  209: --------------------------------------------------------------------------------
  210: */
  211: 
  212:     if ((*s_objet_argument).type == INT)
  213:     {
  214:         a = (*((integer8 *) (*s_objet_argument).objet));
  215: 
  216:         if (depassement_multiplication(&a, &a, &r) == d_absence_erreur)
  217:         {
  218:             if ((s_objet_resultat = allocation(s_etat_processus, INT))
  219:                     == NULL)
  220:             {
  221:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  222:                 return;
  223:             }
  224: 
  225:             (*((integer8 *) (*s_objet_resultat).objet)) = r;
  226:         }
  227:         else
  228:         {
  229:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
  230:                     == NULL)
  231:             {
  232:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  233:                 return;
  234:             }
  235: 
  236:             (*((real8 *) (*s_objet_resultat).objet)) =
  237:                     ((double) (*((integer8 *) (*s_objet_argument).objet))) *
  238:                     ((double) (*((integer8 *) (*s_objet_argument).objet)));
  239:         }
  240:     }
  241: 
  242: /*
  243: --------------------------------------------------------------------------------
  244:   Carré d'un réel
  245: --------------------------------------------------------------------------------
  246: */
  247: 
  248:     else if ((*s_objet_argument).type == REL)
  249:     {
  250:         if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
  251:         {
  252:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  253:             return;
  254:         }
  255: 
  256:         (*((real8 *) (*s_objet_resultat).objet)) =
  257:                 (*((real8 *) (*s_objet_argument).objet)) *
  258:                 (*((real8 *) (*s_objet_argument).objet));
  259:     }
  260: 
  261: /*
  262: --------------------------------------------------------------------------------
  263:   Carré d'un complexe
  264: --------------------------------------------------------------------------------
  265: */
  266: 
  267:     else if ((*s_objet_argument).type == CPL)
  268:     {
  269:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
  270:         {
  271:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  272:             return;
  273:         }
  274: 
  275:         f77multiplicationcc_(&((*((struct_complexe16 *)
  276:                 (*s_objet_argument).objet))), &((*((struct_complexe16 *)
  277:                 (*s_objet_argument).objet))), &((*((struct_complexe16 *)
  278:                 (*s_objet_resultat).objet))));
  279:     }
  280: 
  281: /*
  282: --------------------------------------------------------------------------------
  283:   Carré d'une matrice entière
  284: --------------------------------------------------------------------------------
  285: */
  286: 
  287:     else if ((*s_objet_argument).type == MIN)
  288:     {
  289:         if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
  290:                 (*((struct_matrice *) (*s_objet_argument).objet))
  291:                 .nombre_colonnes)
  292:         {
  293:             liberation(s_etat_processus, s_objet_argument);
  294: 
  295:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  296:             return;
  297:         }
  298: 
  299:         if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
  300:         {
  301:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  302:             return;
  303:         }
  304: 
  305:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
  306:                 (*(((struct_matrice *) (*s_objet_argument)
  307:                 .objet))).nombre_lignes;
  308:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
  309:                 (*(((struct_matrice *) (*s_objet_argument)
  310:                 .objet))).nombre_colonnes;
  311: 
  312:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
  313:                 malloc((*(((struct_matrice *) (*s_objet_resultat)
  314:                 .objet))).nombre_lignes * sizeof(integer8 *))) == NULL)
  315:         {
  316:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  317:             return;
  318:         }
  319: 
  320:         depassement = d_faux;
  321: 
  322:         for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
  323:                 .objet))).nombre_lignes; i++)
  324:         {
  325:             if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
  326:                     malloc((*(((struct_matrice *) (*s_objet_resultat)
  327:                     .objet))).nombre_colonnes * sizeof(integer8))) == NULL)
  328:             {
  329:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  330:                 return;
  331:             }
  332: 
  333:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
  334:                     .objet))).nombre_colonnes; j++)
  335:             {
  336:                 ((integer8 **) (*((struct_matrice *)
  337:                         (*s_objet_resultat).objet)).tableau)[i][j] = 0;
  338: 
  339:                 for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
  340:                         .objet))).nombre_colonnes; k++)
  341:                 {
  342:                     if (depassement_multiplication(&(((integer8 **)
  343:                             (*((struct_matrice *) (*s_objet_argument).objet))
  344:                             .tableau)[i][k]), &(((integer8 **)
  345:                             (*((struct_matrice *) (*s_objet_argument).objet))
  346:                             .tableau)[k][j]), &a) == d_erreur)
  347:                     {
  348:                         depassement = d_vrai;
  349:                     }
  350: 
  351:                     if (depassement_addition(&(((integer8 **)
  352:                             (*((struct_matrice *) (*s_objet_resultat).objet))
  353:                             .tableau)[i][j]), &a, &r) == d_erreur)
  354:                     {
  355:                         depassement = d_vrai;
  356:                     }
  357: 
  358:                     ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
  359:                             .objet)).tableau)[i][j] = r;
  360:                 }
  361:             }
  362:         }
  363: 
  364:         if (depassement == d_vrai)
  365:         {
  366:             (*s_objet_resultat).type = MRL;
  367:             (*((struct_matrice *) (*s_objet_resultat).objet)).type = 'R';
  368: 
  369:             if ((accumulateur = malloc((*(((struct_matrice *)
  370:                     (*s_objet_argument).objet))).nombre_colonnes *
  371:                     sizeof(real8))) == NULL)
  372:             {
  373:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  374:                 return;
  375:             }
  376: 
  377:             for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
  378:                     .objet))).nombre_lignes; i++)
  379:             {
  380:                 free(((integer8 **) (*((struct_matrice *)
  381:                         (*s_objet_resultat).objet)).tableau)[i]);
  382: 
  383:                 if (((*((struct_matrice *) (*s_objet_resultat).objet))
  384:                         .tableau[i] = malloc((*(((struct_matrice *)
  385:                         (*s_objet_resultat).objet))).nombre_colonnes *
  386:                         sizeof(real8))) == NULL)
  387:                 {
  388:                     (*s_etat_processus).erreur_systeme =
  389:                             d_es_allocation_memoire;
  390:                     return;
  391:                 }
  392: 
  393:                 for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
  394:                         .objet))).nombre_colonnes; j++)
  395:                 {
  396:                     ((real8 **) (*((struct_matrice *)
  397:                             (*s_objet_resultat).objet)).tableau)[i][j] = 0;
  398: 
  399:                     for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
  400:                             .objet))).nombre_colonnes; k++)
  401:                     {
  402:                         ((real8 *) accumulateur)[k] = ((real8)
  403:                                 (((integer8 **) (*((struct_matrice *)
  404:                                 (*s_objet_argument).objet)).tableau)[i][k]) *
  405:                                 ((real8) ((integer8 **) (*((struct_matrice *)
  406:                                 (*s_objet_argument).objet)).tableau)[k][j]));
  407:                     }
  408: 
  409:                     ((real8 **) (*((struct_matrice *)
  410:                             (*s_objet_resultat).objet)).tableau)[i][j] =
  411:                             sommation_vecteur_reel(accumulateur,
  412:                             &((*(((struct_matrice *) (*s_objet_argument)
  413:                             .objet))).nombre_colonnes), &erreur_memoire);
  414: 
  415:                     if (erreur_memoire == d_vrai)
  416:                     {
  417:                         (*s_etat_processus).erreur_systeme =
  418:                                 d_es_allocation_memoire;
  419:                         return;
  420:                     }
  421:                 }
  422:             }
  423: 
  424:             free(accumulateur);
  425:         }
  426:     }
  427: 
  428: /*
  429: --------------------------------------------------------------------------------
  430:   Carré d'une matrice réelle
  431: --------------------------------------------------------------------------------
  432: */
  433: 
  434:     else if ((*s_objet_argument).type == MRL)
  435:     {
  436:         if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
  437:                 (*((struct_matrice *) (*s_objet_argument).objet))
  438:                 .nombre_colonnes)
  439:         {
  440:             liberation(s_etat_processus, s_objet_argument);
  441: 
  442:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  443:             return;
  444:         }
  445: 
  446:         if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
  447:         {
  448:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  449:             return;
  450:         }
  451: 
  452:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
  453:                 (*(((struct_matrice *) (*s_objet_argument)
  454:                 .objet))).nombre_lignes;
  455:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
  456:                 (*(((struct_matrice *) (*s_objet_argument)
  457:                 .objet))).nombre_colonnes;
  458: 
  459:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
  460:                 malloc((*(((struct_matrice *) (*s_objet_resultat)
  461:                 .objet))).nombre_lignes * sizeof(real8 *))) == NULL)
  462:         {
  463:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  464:             return;
  465:         }
  466: 
  467:         if ((accumulateur = malloc((*(((struct_matrice *)
  468:                 (*s_objet_argument).objet))).nombre_colonnes * sizeof(real8)))
  469:                 == NULL)
  470:         {
  471:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  472:             return;
  473:         }
  474: 
  475:         for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
  476:                 .objet))).nombre_lignes; i++)
  477:         {
  478:             if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
  479:                     malloc((*(((struct_matrice *) (*s_objet_resultat)
  480:                     .objet))).nombre_colonnes * sizeof(real8))) == NULL)
  481:             {
  482:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  483:                 return;
  484:             }
  485: 
  486:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
  487:                     .objet))).nombre_colonnes; j++)
  488:             {
  489:                 ((real8 **) (*((struct_matrice *)
  490:                         (*s_objet_resultat).objet)).tableau)[i][j] = 0;
  491: 
  492:                 for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
  493:                         .objet))).nombre_colonnes; k++)
  494:                 {
  495:                     ((real8 *) accumulateur)[k] =
  496:                             (((real8 **) (*((struct_matrice *)
  497:                             (*s_objet_argument).objet)).tableau)[i][k] *
  498:                             ((real8 **) (*((struct_matrice *)
  499:                             (*s_objet_argument).objet)).tableau)[k][j]);
  500:                 }
  501: 
  502:                 ((real8 **) (*((struct_matrice *) (*s_objet_resultat).objet))
  503:                         .tableau)[i][j] = sommation_vecteur_reel(
  504:                         accumulateur, &((*(((struct_matrice *)
  505:                         (*s_objet_argument).objet))).nombre_colonnes),
  506:                         &erreur_memoire);
  507: 
  508:                 if (erreur_memoire == d_vrai)
  509:                 {
  510:                     (*s_etat_processus).erreur_systeme =
  511:                             d_es_allocation_memoire;
  512:                     return;
  513:                 }
  514:             }
  515:         }
  516: 
  517:         free(accumulateur);
  518:     }
  519: 
  520: /*
  521: --------------------------------------------------------------------------------
  522:   Carré d'une matrice complexe
  523: --------------------------------------------------------------------------------
  524: */
  525: 
  526:     else if ((*s_objet_argument).type == MCX)
  527:     {
  528:         if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
  529:                 (*((struct_matrice *) (*s_objet_argument).objet))
  530:                 .nombre_colonnes)
  531:         {
  532:             liberation(s_etat_processus, s_objet_argument);
  533: 
  534:             (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
  535:             return;
  536:         }
  537: 
  538:         if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
  539:         {
  540:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  541:             return;
  542:         }
  543: 
  544:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
  545:                 (*(((struct_matrice *) (*s_objet_argument)
  546:                 .objet))).nombre_lignes;
  547:         (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
  548:                 (*(((struct_matrice *) (*s_objet_argument)
  549:                 .objet))).nombre_colonnes;
  550: 
  551:         if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
  552:                 malloc((*(((struct_matrice *) (*s_objet_resultat)
  553:                 .objet))).nombre_lignes * sizeof(struct_complexe16 *))) == NULL)
  554:         {
  555:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  556:             return;
  557:         }
  558: 
  559:         if ((accumulateur = malloc((*(((struct_matrice *)
  560:                 (*s_objet_argument).objet))).nombre_colonnes *
  561:                 sizeof(complex16))) == NULL)
  562:         {
  563:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  564:             return;
  565:         }
  566: 
  567:         for(i = 0; i < (*(((struct_matrice *) (*s_objet_resultat)
  568:                 .objet))).nombre_lignes; i++)
  569:         {
  570:             if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau[i] =
  571:                     malloc((*(((struct_matrice *) (*s_objet_resultat)
  572:                     .objet))).nombre_colonnes * sizeof(struct_complexe16)))
  573:                     == NULL)
  574:             {
  575:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  576:                 return;
  577:             }
  578: 
  579:             for(j = 0; j < (*(((struct_matrice *) (*s_objet_resultat)
  580:                     .objet))).nombre_colonnes; j++)
  581:             {
  582:                 ((struct_complexe16 **) (*((struct_matrice *)
  583:                         (*s_objet_resultat).objet)).tableau)[i][j]
  584:                         .partie_reelle = 0;
  585:                 ((struct_complexe16 **) (*((struct_matrice *)
  586:                         (*s_objet_resultat).objet)).tableau)[i][j]
  587:                         .partie_imaginaire = 0;
  588: 
  589:                 for(k = 0; k < (*(((struct_matrice *) (*s_objet_argument)
  590:                         .objet))).nombre_colonnes; k++)
  591:                 {
  592:                     f77multiplicationcc_(&(((struct_complexe16 **)
  593:                             (*((struct_matrice *) (*s_objet_argument).objet))
  594:                             .tableau)[i][k]), &(((struct_complexe16 **)
  595:                             (*((struct_matrice *) (*s_objet_argument).objet))
  596:                             .tableau)[k][j]), &(((complex16 *)
  597:                             accumulateur)[k]));
  598:                 }
  599: 
  600:                 ((complex16 **) (*((struct_matrice *)
  601:                         (*s_objet_resultat).objet)).tableau)[i][j] =
  602:                         sommation_vecteur_complexe(accumulateur,
  603:                         &((*(((struct_matrice *)
  604:                         (*s_objet_argument).objet))).nombre_colonnes),
  605:                         &erreur_memoire);
  606: 
  607:                 if (erreur_memoire == d_vrai)
  608:                 {
  609:                     (*s_etat_processus).erreur_systeme =
  610:                             d_es_allocation_memoire;
  611:                     return;
  612:                 }
  613:             }
  614:         }
  615: 
  616:         free(accumulateur);
  617:     }
  618: 
  619: /*
  620: --------------------------------------------------------------------------------
  621:   Carré d'un nom
  622: --------------------------------------------------------------------------------
  623: */
  624:     else if ((*s_objet_argument).type == NOM)
  625:     {
  626:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
  627:         {
  628:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  629:             return;
  630:         }
  631: 
  632:         if (((*s_objet_resultat).objet =
  633:                 allocation_maillon(s_etat_processus)) == NULL)
  634:         {
  635:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  636:             return;
  637:         }
  638: 
  639:         l_element_courant = (*s_objet_resultat).objet;
  640: 
  641:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  642:                 == NULL)
  643:         {
  644:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  645:             return;
  646:         }
  647: 
  648:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  649:                 .nombre_arguments = 0;
  650:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  651:                 .fonction = instruction_vers_niveau_superieur;
  652: 
  653:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  654:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  655:         {
  656:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  657:             return;
  658:         }
  659: 
  660:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  661:                 .nom_fonction, "<<");
  662: 
  663:         if (((*l_element_courant).suivant =
  664:                 allocation_maillon(s_etat_processus)) == NULL)
  665:         {
  666:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  667:             return;
  668:         }
  669: 
  670:         l_element_courant = (*l_element_courant).suivant;
  671:         (*l_element_courant).donnee = s_objet_argument;
  672: 
  673:         if (((*l_element_courant).suivant =
  674:                 allocation_maillon(s_etat_processus)) == NULL)
  675:         {
  676:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  677:             return;
  678:         }
  679: 
  680:         l_element_courant = (*l_element_courant).suivant;
  681: 
  682:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  683:                 == NULL)
  684:         {
  685:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  686:             return;
  687:         }
  688: 
  689:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  690:                 .nombre_arguments = 1;
  691:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  692:                 .fonction = instruction_sq;
  693: 
  694:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  695:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  696:         {
  697:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  698:             return;
  699:         }
  700:             
  701:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  702:                 .nom_fonction, "SQ");
  703: 
  704:         if (((*l_element_courant).suivant =
  705:                 allocation_maillon(s_etat_processus)) == NULL)
  706:         {
  707:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  708:             return;
  709:         }
  710: 
  711:         l_element_courant = (*l_element_courant).suivant;
  712: 
  713:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
  714:                 == NULL)
  715:         {
  716:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  717:             return;
  718:         }
  719: 
  720:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  721:                 .nombre_arguments = 0;
  722:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  723:                 .fonction = instruction_vers_niveau_inferieur;
  724: 
  725:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  726:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  727:         {
  728:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  729:             return;
  730:         }
  731: 
  732:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  733:                 .nom_fonction, ">>");
  734: 
  735:         (*l_element_courant).suivant = NULL;
  736:         s_objet_argument = NULL;
  737:     }
  738: 
  739: /*
  740: --------------------------------------------------------------------------------
  741:   Carré d'une expression
  742: --------------------------------------------------------------------------------
  743: */
  744: 
  745:     else if (((*s_objet_argument).type == ALG) ||
  746:             ((*s_objet_argument).type == RPN))
  747:     {
  748:         if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
  749:                 'N')) == NULL)
  750:         {
  751:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  752:             return;
  753:         }
  754: 
  755:         l_element_courant = (struct_liste_chainee *)
  756:                 (*s_copie_argument).objet;
  757:         l_element_precedent = l_element_courant;
  758: 
  759:         while((*l_element_courant).suivant != NULL)
  760:         {
  761:             l_element_precedent = l_element_courant;
  762:             l_element_courant = (*l_element_courant).suivant;
  763:         }
  764: 
  765:         if (((*l_element_precedent).suivant =
  766:                 allocation_maillon(s_etat_processus)) == NULL)
  767:         {
  768:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  769:             return;
  770:         }
  771: 
  772:         if (((*(*l_element_precedent).suivant).donnee =
  773:                 allocation(s_etat_processus, FCT)) == NULL)
  774:         {
  775:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  776:             return;
  777:         }
  778: 
  779:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  780:                 .donnee).objet)).nombre_arguments = 1;
  781:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  782:                 .donnee).objet)).fonction = instruction_sq;
  783: 
  784:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
  785:                 .suivant).donnee).objet)).nom_fonction =
  786:                 malloc(3 * sizeof(unsigned char))) == NULL)
  787:         {
  788:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  789:             return;
  790:         }
  791: 
  792:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
  793:                 .suivant).donnee).objet)).nom_fonction, "SQ");
  794: 
  795:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  796: 
  797:         s_objet_resultat = s_copie_argument;
  798:     }
  799: 
  800: /*
  801: --------------------------------------------------------------------------------
  802:   Carré impossible
  803: --------------------------------------------------------------------------------
  804: */
  805: 
  806:     else
  807:     {
  808:         liberation(s_etat_processus, s_objet_argument);
  809: 
  810:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  811:         return;
  812:     }
  813: 
  814:     liberation(s_etat_processus, s_objet_argument);
  815: 
  816:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  817:             s_objet_resultat) == d_erreur)
  818:     {
  819:         return;
  820:     }
  821: 
  822:     return;
  823: }
  824: 
  825: 
  826: /*
  827: ================================================================================
  828:   Fonction 'sqrt'
  829: ================================================================================
  830:   Entrées : pointeur sur une struct_processus
  831: --------------------------------------------------------------------------------
  832:   Sorties :
  833: --------------------------------------------------------------------------------
  834:   Effets de bord : néant
  835: ================================================================================
  836: */
  837: 
  838: void
  839: instruction_sqrt(struct_processus *s_etat_processus)
  840: {
  841:     struct_liste_chainee            *l_element_courant;
  842:     struct_liste_chainee            *l_element_precedent;
  843: 
  844:     struct_objet                    *s_copie_argument;
  845:     struct_objet                    *s_objet_argument;
  846:     struct_objet                    *s_objet_resultat;
  847: 
  848:     (*s_etat_processus).erreur_execution = d_ex;
  849: 
  850:     if ((*s_etat_processus).affichage_arguments == 'Y')
  851:     {
  852:         printf("\n  SQRT ");
  853: 
  854:         if ((*s_etat_processus).langue == 'F')
  855:         {
  856:             printf("(racine carrée)\n\n");
  857:         }
  858:         else
  859:         {
  860:             printf("(square root)\n\n");
  861:         }
  862: 
  863:         printf("    1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
  864:         printf("->  1: %s, %s\n\n", d_REL, d_CPL);
  865: 
  866:         printf("    1: %s, %s\n", d_NOM, d_ALG);
  867:         printf("->  1: %s\n\n", d_ALG);
  868: 
  869:         printf("    1: %s\n", d_RPN);
  870:         printf("->  1: %s\n", d_RPN);
  871: 
  872:         return;
  873:     }
  874:     else if ((*s_etat_processus).test_instruction == 'Y')
  875:     {
  876:         (*s_etat_processus).nombre_arguments = 1;
  877:         return;
  878:     }
  879: 
  880:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  881:     {
  882:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  883:         {
  884:             return;
  885:         }
  886:     }
  887: 
  888:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  889:             &s_objet_argument) == d_erreur)
  890:     {
  891:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  892:         return;
  893:     }
  894: 
  895: /*
  896: --------------------------------------------------------------------------------
  897:   Racine carrée d'un entier
  898: --------------------------------------------------------------------------------
  899: */
  900: 
  901:     if ((*s_objet_argument).type == INT)
  902:     {
  903:         if ((*((integer8 *) (*s_objet_argument).objet)) >= 0)
  904:         {
  905:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
  906:                     == NULL)
  907:             {
  908:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  909:                 return;
  910:             }
  911: 
  912:             f77racinecarreeip_(&((*((integer8 *) (*s_objet_argument).objet))),
  913:                     &((*((real8 *) (*s_objet_resultat).objet))));
  914:         }
  915:         else
  916:         {
  917:             if ((s_objet_resultat = allocation(s_etat_processus, CPL))
  918:                     == NULL)
  919:             {
  920:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  921:                 return;
  922:             }
  923: 
  924:             f77racinecarreein_(&((*((integer8 *) (*s_objet_argument).objet))),
  925:                     &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
  926:         }
  927:     }
  928: 
  929: /*
  930: --------------------------------------------------------------------------------
  931:   Racine carré d'un réel
  932: --------------------------------------------------------------------------------
  933: */
  934: 
  935:     else if ((*s_objet_argument).type == REL)
  936:     {
  937:         if ((*((real8 *) (*s_objet_argument).objet)) >= 0)
  938:         {
  939:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
  940:                     == NULL)
  941:             {
  942:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  943:                 return;
  944:             }
  945: 
  946:             f77racinecarreerp_(&((*((real8 *) (*s_objet_argument).objet))),
  947:                     &((*((real8 *) (*s_objet_resultat).objet))));
  948:         }
  949:         else
  950:         {
  951:             if ((s_objet_resultat = allocation(s_etat_processus, CPL))
  952:                     == NULL)
  953:             {
  954:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  955:                 return;
  956:             }
  957: 
  958:             f77racinecarreern_(&((*((real8 *) (*s_objet_argument).objet))),
  959:                     &((*((struct_complexe16 *) (*s_objet_resultat).objet))));
  960:         }
  961:     }
  962: 
  963: /*
  964: --------------------------------------------------------------------------------
  965:   Racine carrée d'un complexe
  966: --------------------------------------------------------------------------------
  967: */
  968: 
  969:     else if ((*s_objet_argument).type == CPL)
  970:     {
  971:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
  972:         {
  973:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  974:             return;
  975:         }
  976: 
  977:         f77racinecarreec_(&((*((struct_complexe16 *) (*s_objet_argument)
  978:                 .objet))), &((*((struct_complexe16 *) (*s_objet_resultat)
  979:                 .objet))));
  980:     }
  981: 
  982: /*
  983: --------------------------------------------------------------------------------
  984:   Racine carrée d'un nom
  985: --------------------------------------------------------------------------------
  986: */
  987: 
  988:     else if ((*s_objet_argument).type == NOM)
  989:     {
  990:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
  991:         {
  992:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  993:             return;
  994:         }
  995: 
  996:         if (((*s_objet_resultat).objet =
  997:                 allocation_maillon(s_etat_processus)) == NULL)
  998:         {
  999:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1000:             return;
 1001:         }
 1002: 
 1003:         l_element_courant = (*s_objet_resultat).objet;
 1004: 
 1005:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1006:                 == NULL)
 1007:         {
 1008:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1009:             return;
 1010:         }
 1011: 
 1012:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1013:                 .nombre_arguments = 0;
 1014:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1015:                 .fonction = instruction_vers_niveau_superieur;
 1016: 
 1017:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1018:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1019:         {
 1020:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1021:             return;
 1022:         }
 1023: 
 1024:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1025:                 .nom_fonction, "<<");
 1026: 
 1027:         if (((*l_element_courant).suivant =
 1028:                 allocation_maillon(s_etat_processus)) == NULL)
 1029:         {
 1030:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1031:             return;
 1032:         }
 1033: 
 1034:         l_element_courant = (*l_element_courant).suivant;
 1035:         (*l_element_courant).donnee = s_objet_argument;
 1036: 
 1037:         if (((*l_element_courant).suivant =
 1038:                 allocation_maillon(s_etat_processus)) == NULL)
 1039:         {
 1040:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1041:             return;
 1042:         }
 1043: 
 1044:         l_element_courant = (*l_element_courant).suivant;
 1045: 
 1046:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1047:                 == NULL)
 1048:         {
 1049:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1050:             return;
 1051:         }
 1052: 
 1053:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1054:                 .nombre_arguments = 1;
 1055:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1056:                 .fonction = instruction_sqrt;
 1057: 
 1058:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1059:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 1060:         {
 1061:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1062:             return;
 1063:         }
 1064:             
 1065:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1066:                 .nom_fonction, "SQRT");
 1067: 
 1068:         if (((*l_element_courant).suivant =
 1069:                 allocation_maillon(s_etat_processus)) == NULL)
 1070:         {
 1071:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1072:             return;
 1073:         }
 1074: 
 1075:         l_element_courant = (*l_element_courant).suivant;
 1076: 
 1077:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 1078:                 == NULL)
 1079:         {
 1080:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1081:             return;
 1082:         }
 1083: 
 1084:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1085:                 .nombre_arguments = 0;
 1086:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1087:                 .fonction = instruction_vers_niveau_inferieur;
 1088: 
 1089:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1090:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 1091:         {
 1092:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1093:             return;
 1094:         }
 1095: 
 1096:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 1097:                 .nom_fonction, ">>");
 1098: 
 1099:         (*l_element_courant).suivant = NULL;
 1100:         s_objet_argument = NULL;
 1101:     }
 1102: 
 1103: /*
 1104: --------------------------------------------------------------------------------
 1105:   Racine carrée d'une expression
 1106: --------------------------------------------------------------------------------
 1107: */
 1108: 
 1109:     else if (((*s_objet_argument).type == ALG) ||
 1110:             ((*s_objet_argument).type == RPN))
 1111:     {
 1112:         if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
 1113:                 'N')) == NULL)
 1114:         {
 1115:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1116:             return;
 1117:         }
 1118: 
 1119:         l_element_courant = (struct_liste_chainee *)
 1120:                 (*s_copie_argument).objet;
 1121:         l_element_precedent = l_element_courant;
 1122: 
 1123:         while((*l_element_courant).suivant != NULL)
 1124:         {
 1125:             l_element_precedent = l_element_courant;
 1126:             l_element_courant = (*l_element_courant).suivant;
 1127:         }
 1128: 
 1129:         if (((*l_element_precedent).suivant =
 1130:                 allocation_maillon(s_etat_processus)) == NULL)
 1131:         {
 1132:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1133:             return;
 1134:         }
 1135: 
 1136:         if (((*(*l_element_precedent).suivant).donnee =
 1137:                 allocation(s_etat_processus, FCT)) == NULL)
 1138:         {
 1139:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1140:             return;
 1141:         }
 1142: 
 1143:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1144:                 .donnee).objet)).nombre_arguments = 1;
 1145:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 1146:                 .donnee).objet)).fonction = instruction_sqrt;
 1147: 
 1148:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 1149:                 .suivant).donnee).objet)).nom_fonction =
 1150:                 malloc(5 * sizeof(unsigned char))) == NULL)
 1151:         {
 1152:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1153:             return;
 1154:         }
 1155: 
 1156:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 1157:                 .suivant).donnee).objet)).nom_fonction, "SQRT");
 1158: 
 1159:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 1160: 
 1161:         s_objet_resultat = s_copie_argument;
 1162:     }
 1163: 
 1164: /*
 1165: --------------------------------------------------------------------------------
 1166:   Racine carrée impossible
 1167: --------------------------------------------------------------------------------
 1168: */
 1169: 
 1170:     else
 1171:     {
 1172:         liberation(s_etat_processus, s_objet_argument);
 1173: 
 1174:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 1175:         return;
 1176:     }
 1177: 
 1178:     liberation(s_etat_processus, s_objet_argument);
 1179: 
 1180:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1181:             s_objet_resultat) == d_erreur)
 1182:     {
 1183:         return;
 1184:     }
 1185: 
 1186:     return;
 1187: }
 1188: 
 1189: 
 1190: /*
 1191: ================================================================================
 1192:   Fonction 'same'
 1193: ================================================================================
 1194:   Entrées : pointeur sur une structure struct_processus
 1195: --------------------------------------------------------------------------------
 1196:   Sorties :
 1197: --------------------------------------------------------------------------------
 1198:   Effets de bord : néant
 1199: ================================================================================
 1200: */
 1201: 
 1202: void
 1203: instruction_same(struct_processus *s_etat_processus)
 1204: {
 1205:     struct_liste_chainee        *l_element_courant;
 1206:     struct_liste_chainee        *l_element_courant_1;
 1207:     struct_liste_chainee        *l_element_courant_2;
 1208:     struct_liste_chainee        *l_element_precedent;
 1209: 
 1210:     struct_objet                *s_copie_argument_1;
 1211:     struct_objet                *s_copie_argument_2;
 1212:     struct_objet                *s_objet_argument_1;
 1213:     struct_objet                *s_objet_argument_2;
 1214:     struct_objet                *s_objet_resultat;
 1215:     struct_objet                *s_objet_resultat_intermediaire;
 1216: 
 1217:     logical1                    difference;
 1218: 
 1219:     unsigned long               i;
 1220:     unsigned long               j;
 1221:     unsigned long               nombre_elements;
 1222: 
 1223:     (*s_etat_processus).erreur_execution = d_ex;
 1224: 
 1225:     if ((*s_etat_processus).affichage_arguments == 'Y')
 1226:     {
 1227:         printf("\n  SAME ");
 1228: 
 1229:         if ((*s_etat_processus).langue == 'F')
 1230:         {
 1231:             printf("(opérateur égalité)\n\n");
 1232:         }
 1233:         else
 1234:         {
 1235:             printf("(equality operator)\n\n");
 1236:         }
 1237: 
 1238:         printf("    2: %s, %s, %s\n", d_INT, d_REL, d_CPL);
 1239:         printf("    1: %s, %s, %s\n", d_INT, d_REL, d_CPL);
 1240:         printf("->  1: %s\n\n", d_INT);
 1241: 
 1242:         printf("    2: %s\n", d_BIN);
 1243:         printf("    1: %s\n", d_BIN);
 1244:         printf("->  1: %s\n\n", d_INT);
 1245: 
 1246:         printf("    2: %s\n", d_LST);
 1247:         printf("    1: %s\n", d_LST);
 1248:         printf("->  1: %s\n\n", d_INT);
 1249: 
 1250:         printf("    2: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
 1251:         printf("    1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
 1252:         printf("->  1: %s\n\n", d_INT);
 1253: 
 1254:         printf("    2: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
 1255:         printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
 1256:         printf("->  1: %s\n\n", d_INT);
 1257: 
 1258:         printf("    2: %s\n", d_TAB);
 1259:         printf("    1: %s\n", d_TAB);
 1260:         printf("->  1: %s\n\n", d_INT);
 1261: 
 1262:         printf("    2: %s\n", d_NOM);
 1263:         printf("    1: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
 1264:         printf("->  1: %s\n\n", d_ALG);
 1265: 
 1266:         printf("    2: %s, %s, %s, %s\n", d_NOM, d_ALG, d_INT, d_REL);
 1267:         printf("    1: %s\n", d_NOM);
 1268:         printf("->  1: %s\n\n", d_ALG);
 1269: 
 1270:         printf("    2: %s\n", d_ALG);
 1271:         printf("    1: %s\n", d_ALG);
 1272:         printf("->  1: %s\n\n", d_ALG);
 1273: 
 1274:         printf("    2: %s\n", d_RPN);
 1275:         printf("    1: %s\n", d_RPN);
 1276:         printf("->  1: %s\n", d_RPN);
 1277: 
 1278:         printf("    2: %s\n", d_PRC);
 1279:         printf("    1: %s\n", d_PRC);
 1280:         printf("->  1: %s\n", d_INT);
 1281: 
 1282:         return;
 1283:     }
 1284:     else if ((*s_etat_processus).test_instruction == 'Y')
 1285:     {
 1286:         (*s_etat_processus).nombre_arguments = -1;
 1287:         return;
 1288:     }
 1289:     
 1290:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1291:     {
 1292:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 1293:         {
 1294:         return;
 1295:     }
 1296:     }
 1297: 
 1298:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1299:             &s_objet_argument_1) == d_erreur)
 1300:     {
 1301:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1302:         return;
 1303:     }
 1304: 
 1305:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1306:             &s_objet_argument_2) == d_erreur)
 1307:     {
 1308:         liberation(s_etat_processus, s_objet_argument_1);
 1309: 
 1310:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1311:         return;
 1312:     }
 1313: 
 1314: /*
 1315: --------------------------------------------------------------------------------
 1316:   SAME sur des valeurs numériques
 1317: --------------------------------------------------------------------------------
 1318: */
 1319: 
 1320:     if ((((*s_objet_argument_1).type == INT) ||
 1321:             ((*s_objet_argument_1).type == REL)) &&
 1322:             (((*s_objet_argument_2).type == INT) ||
 1323:             ((*s_objet_argument_2).type == REL)))
 1324:     {
 1325:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1326:         {
 1327:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1328:             return;
 1329:         }
 1330: 
 1331:         if ((*s_objet_argument_1).type == INT)
 1332:         {
 1333:             if ((*s_objet_argument_2).type == INT)
 1334:             {
 1335:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1336:                         ((*((integer8 *) (*s_objet_argument_1).objet)) ==
 1337:                         (*((integer8 *) (*s_objet_argument_2).objet)))
 1338:                         ? -1 : 0;
 1339:             }
 1340:             else
 1341:             {
 1342:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1343:                         ((*((integer8 *) (*s_objet_argument_1).objet)) ==
 1344:                         (*((real8 *) (*s_objet_argument_2).objet)))
 1345:                         ? -1 : 0;
 1346:             }
 1347:         }
 1348:         else
 1349:         {
 1350:             if ((*s_objet_argument_2).type == INT)
 1351:             {
 1352:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1353:                         ((*((real8 *) (*s_objet_argument_1).objet)) ==
 1354:                         (*((integer8 *) (*s_objet_argument_2).objet)))
 1355:                         ? -1 : 0;
 1356:             }
 1357:             else
 1358:             {
 1359:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1360:                         ((*((real8 *) (*s_objet_argument_1).objet)) ==
 1361:                         (*((real8 *) (*s_objet_argument_2).objet)))
 1362:                         ? -1 : 0;
 1363:             }
 1364:         }
 1365:     }
 1366: 
 1367: /*
 1368: --------------------------------------------------------------------------------
 1369:   SAME Processus
 1370: --------------------------------------------------------------------------------
 1371: */
 1372: 
 1373:     else if (((*s_objet_argument_1).type == PRC) &&
 1374:             ((*s_objet_argument_2).type == PRC))
 1375:     {
 1376:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1377:         {
 1378:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1379:             return;
 1380:         }
 1381: 
 1382:         if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet)).thread)
 1383:                 .processus_detache != (*(*((struct_processus_fils *)
 1384:                 (*s_objet_argument_2).objet)).thread).processus_detache)
 1385:         {
 1386:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1387:         }
 1388:         else
 1389:         {
 1390:             if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet))
 1391:                     .thread).processus_detache == d_vrai)
 1392:             {
 1393:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1394:                         ((*(*((struct_processus_fils *) (*s_objet_argument_1)
 1395:                         .objet)).thread).pid ==
 1396:                         (*(*((struct_processus_fils *) (*s_objet_argument_2)
 1397:                         .objet)).thread).pid) ? -1 : 0;
 1398:             }
 1399:             else
 1400:             {
 1401:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1402:                         ((pthread_equal((*(*((struct_processus_fils *)
 1403:                         (*s_objet_argument_1).objet)).thread).tid,
 1404:                         (*(*((struct_processus_fils *) (*s_objet_argument_2)
 1405:                         .objet)).thread).tid) != 0) &&
 1406:                         ((*(*((struct_processus_fils *)
 1407:                         (*s_objet_argument_1).objet)).thread).pid ==
 1408:                         (*(*((struct_processus_fils *) (*s_objet_argument_2)
 1409:                         .objet)).thread).pid)) ? -1 : 0;
 1410:             }
 1411:         }
 1412:     }
 1413: 
 1414: /*
 1415: --------------------------------------------------------------------------------
 1416:   SAME complexe
 1417: --------------------------------------------------------------------------------
 1418: */
 1419: 
 1420:     else if (((*s_objet_argument_1).type == CPL) &&
 1421:             ((*s_objet_argument_2).type == CPL))
 1422:     {
 1423:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1424:         {
 1425:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1426:             return;
 1427:         }
 1428: 
 1429:         (*((integer8 *) (*s_objet_resultat).objet)) =
 1430:                 (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
 1431:                 .partie_reelle == (*((struct_complexe16 *) (*s_objet_argument_2)
 1432:                 .objet)).partie_reelle) && ((*((struct_complexe16 *)
 1433:                 (*s_objet_argument_1).objet)).partie_imaginaire ==
 1434:                 ((*((struct_complexe16 *) (*s_objet_argument_1).objet))
 1435:                 .partie_imaginaire))) ? -1 : 0;
 1436:     }
 1437: 
 1438: /*
 1439: --------------------------------------------------------------------------------
 1440:   SAME binaire
 1441: --------------------------------------------------------------------------------
 1442: */
 1443: 
 1444:     else if (((*s_objet_argument_1).type == BIN) &&
 1445:             ((*s_objet_argument_2).type == BIN))
 1446:     {
 1447:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1448:         {
 1449:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1450:             return;
 1451:         }
 1452: 
 1453:         (*((integer8 *) (*s_objet_resultat).objet)) = 
 1454:                 ((*((logical8 *) (*s_objet_argument_1).objet)) ==
 1455:                 (*((logical8 *) (*s_objet_argument_2).objet)))
 1456:                 ? -1 : 0;
 1457:     }
 1458: 
 1459: /*
 1460: --------------------------------------------------------------------------------
 1461:   SAME portant sur des chaînes de caractères
 1462: --------------------------------------------------------------------------------
 1463: */
 1464: 
 1465:     else if (((*s_objet_argument_1).type == CHN) &&
 1466:             ((*s_objet_argument_2).type == CHN))
 1467:     {
 1468:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1469:         {
 1470:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1471:             return;
 1472:         }
 1473: 
 1474:         (*((integer8 *) (*s_objet_resultat).objet)) =
 1475:                 (strcmp((unsigned char *) (*s_objet_argument_1).objet,
 1476:                 (unsigned char *) (*s_objet_argument_2).objet) == 0) ? -1 : 0;
 1477:     }
 1478: 
 1479: /*
 1480: --------------------------------------------------------------------------------
 1481:   SAME portant sur des listes ou (instruction "SAME") des expressions
 1482: --------------------------------------------------------------------------------
 1483: */
 1484: 
 1485:     else if (((*s_objet_argument_1).type == FCT) &&
 1486:             ((*s_objet_argument_2).type == FCT))
 1487:     {
 1488:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1489:         {
 1490:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1491:             return;
 1492:         }
 1493: 
 1494:         if ((strcmp((*((struct_fonction *) (*s_objet_argument_1).objet))
 1495:                 .nom_fonction, (*((struct_fonction *) (*s_objet_argument_2)
 1496:                 .objet)).nom_fonction) == 0) &&
 1497:                 ((*((struct_fonction *) (*s_objet_argument_1).objet))
 1498:                 .nombre_arguments == (*((struct_fonction *)
 1499:                 (*s_objet_argument_2).objet)).nombre_arguments))
 1500:         {
 1501:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 1502:         }
 1503:         else
 1504:         {
 1505:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1506:         }
 1507:     }
 1508: 
 1509:     /*
 1510:      * Il y a de la récursivité dans l'air...
 1511:      */
 1512: 
 1513:     else if ((((*s_objet_argument_1).type == LST) &&
 1514:             ((*s_objet_argument_2).type == LST)) ||
 1515:             (((((*s_objet_argument_1).type == ALG) &&
 1516:             ((*s_objet_argument_2).type == ALG)) ||
 1517:             (((*s_objet_argument_1).type == RPN) &&
 1518:             ((*s_objet_argument_2).type == RPN))) &&
 1519:             (strcmp((*s_etat_processus).instruction_courante, "==") != 0)))
 1520:     {
 1521:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1522:         {
 1523:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1524:             return;
 1525:         }
 1526: 
 1527:         l_element_courant_1 = (struct_liste_chainee *)
 1528:                 (*s_objet_argument_1).objet;
 1529:         l_element_courant_2 = (struct_liste_chainee *)
 1530:                 (*s_objet_argument_2).objet;
 1531: 
 1532:         difference = d_faux;
 1533: 
 1534:         while((l_element_courant_1 != NULL) && (l_element_courant_2 != NULL)
 1535:                 && (difference == d_faux))
 1536:         {
 1537:             if ((s_copie_argument_1 = copie_objet(s_etat_processus,
 1538:                     (*l_element_courant_1).donnee, 'P')) == NULL)
 1539:             {
 1540:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1541:                 return;
 1542:             }
 1543: 
 1544:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1545:                     s_copie_argument_1) == d_erreur)
 1546:             {
 1547:                 return;
 1548:             }
 1549: 
 1550:             if ((s_copie_argument_2 = copie_objet(s_etat_processus,
 1551:                     (*l_element_courant_2).donnee, 'P')) == NULL)
 1552:             {
 1553:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1554:                 return;
 1555:             }
 1556: 
 1557:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1558:                     s_copie_argument_2) == d_erreur)
 1559:             {
 1560:                 return;
 1561:             }
 1562: 
 1563:             instruction_same(s_etat_processus);
 1564: 
 1565:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1566:                     &s_objet_resultat_intermediaire) == d_erreur)
 1567:             {
 1568:                 liberation(s_etat_processus, s_objet_argument_1);
 1569:                 liberation(s_etat_processus, s_objet_argument_2);
 1570:                 liberation(s_etat_processus, s_objet_resultat);
 1571: 
 1572:                 (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1573:                 return;
 1574:             }
 1575: 
 1576:             if ((*s_objet_resultat_intermediaire).type != INT)
 1577:             {
 1578:                 liberation(s_etat_processus, s_objet_argument_1);
 1579:                 liberation(s_etat_processus, s_objet_argument_2);
 1580:                 liberation(s_etat_processus, s_objet_resultat);
 1581: 
 1582:                 (*s_etat_processus).erreur_execution =
 1583:                         d_ex_erreur_type_argument;
 1584: 
 1585:                 return;
 1586:             }
 1587: 
 1588:             difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
 1589:                     .objet)) == 0) ? d_vrai : d_faux;
 1590: 
 1591:             liberation(s_etat_processus, s_objet_resultat_intermediaire);
 1592: 
 1593:             l_element_courant_1 = (*l_element_courant_1).suivant;
 1594:             l_element_courant_2 = (*l_element_courant_2).suivant;
 1595:         }
 1596: 
 1597:         if ((difference == d_vrai) || ((l_element_courant_1 != NULL) &&
 1598:                 (l_element_courant_2 == NULL)) ||
 1599:                 ((l_element_courant_1 == NULL) &&
 1600:                 (l_element_courant_2 != NULL)))
 1601:         {
 1602:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1603:         }
 1604:         else
 1605:         {
 1606:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 1607:         }
 1608:     }
 1609: 
 1610: /*
 1611: --------------------------------------------------------------------------------
 1612:   SAME portant sur des tables des expressions
 1613: --------------------------------------------------------------------------------
 1614: */
 1615:     /*
 1616:      * Il y a de la récursivité dans l'air...
 1617:      */
 1618: 
 1619:     else if (((*s_objet_argument_1).type == TBL) &&
 1620:             ((*s_objet_argument_2).type == TBL) &&
 1621:             (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
 1622:     {
 1623:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1624:         {
 1625:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1626:             return;
 1627:         }
 1628: 
 1629:         if ((*((struct_tableau *) (*s_objet_argument_1).objet)).nombre_elements
 1630:                 != (*((struct_tableau *) (*s_objet_argument_2).objet))
 1631:                 .nombre_elements)
 1632:         {
 1633:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1634:         }
 1635:         else
 1636:         {
 1637:             difference = d_faux;
 1638: 
 1639:             for(i = 0; i < (*((struct_tableau *) (*s_objet_argument_1).objet))
 1640:                     .nombre_elements; i++)
 1641:             {
 1642:                 if ((s_copie_argument_1 = copie_objet(s_etat_processus,
 1643:                         (*((struct_tableau *)
 1644:                         (*s_objet_argument_1).objet)).elements[i],
 1645:                         'P')) == NULL)
 1646:                 {
 1647:                     (*s_etat_processus).erreur_systeme =
 1648:                             d_es_allocation_memoire;
 1649:                     return;
 1650:                 }
 1651: 
 1652:                 if (empilement(s_etat_processus, &((*s_etat_processus)
 1653:                         .l_base_pile), s_copie_argument_1) == d_erreur)
 1654:                 {
 1655:                     return;
 1656:                 }
 1657: 
 1658:                 if ((s_copie_argument_2 = copie_objet(s_etat_processus,
 1659:                         (*((struct_tableau *)
 1660:                         (*s_objet_argument_2).objet)).elements[i],
 1661:                         'P')) == NULL)
 1662:                 {
 1663:                     (*s_etat_processus).erreur_systeme =
 1664:                             d_es_allocation_memoire;
 1665:                     return;
 1666:                 }
 1667: 
 1668:                 if (empilement(s_etat_processus, &((*s_etat_processus)
 1669:                         .l_base_pile), s_copie_argument_2) == d_erreur)
 1670:                 {
 1671:                     return;
 1672:                 }
 1673: 
 1674:                 instruction_same(s_etat_processus);
 1675: 
 1676:                 if (depilement(s_etat_processus, &((*s_etat_processus)
 1677:                         .l_base_pile), &s_objet_resultat_intermediaire)
 1678:                         == d_erreur)
 1679:                 {
 1680:                     liberation(s_etat_processus, s_objet_argument_1);
 1681:                     liberation(s_etat_processus, s_objet_argument_2);
 1682:                     liberation(s_etat_processus, s_objet_resultat);
 1683: 
 1684:                     (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1685:                     return;
 1686:                 }
 1687: 
 1688:                 if ((*s_objet_resultat_intermediaire).type != INT)
 1689:                 {
 1690:                     liberation(s_etat_processus, s_objet_argument_1);
 1691:                     liberation(s_etat_processus, s_objet_argument_2);
 1692:                     liberation(s_etat_processus, s_objet_resultat);
 1693: 
 1694:                     (*s_etat_processus).erreur_execution =
 1695:                             d_ex_erreur_type_argument;
 1696:                     return;
 1697:                 }
 1698: 
 1699:                 difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
 1700:                         .objet)) == 0) ? d_vrai : d_faux;
 1701: 
 1702:                 liberation(s_etat_processus, s_objet_resultat_intermediaire);
 1703:             }
 1704: 
 1705:             if (difference == d_vrai)
 1706:             {
 1707:                 (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1708:             }
 1709:             else
 1710:             {
 1711:                 (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 1712:             }
 1713:         }
 1714:     }
 1715: 
 1716: 
 1717: /*
 1718: --------------------------------------------------------------------------------
 1719:   SAME portant sur des vecteurs
 1720: --------------------------------------------------------------------------------
 1721: */
 1722:     /*
 1723:      * Vecteurs d'entiers
 1724:      */
 1725: 
 1726:     else if (((*s_objet_argument_1).type == VIN) &&
 1727:             ((*s_objet_argument_2).type == VIN))
 1728:     {
 1729:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1730:         {
 1731:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1732:             return;
 1733:         }
 1734: 
 1735:         if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
 1736:                 (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
 1737:         {
 1738:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1739:         }
 1740:         else
 1741:         {
 1742:             difference = d_faux;
 1743: 
 1744:             for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
 1745:                     .taille) && (difference == d_faux); i++)
 1746:             {
 1747:                 difference = (((integer8 *) (*((struct_vecteur *)
 1748:                         (*s_objet_argument_1).objet)).tableau)[i] ==
 1749:                         ((integer8 *) (*((struct_vecteur *)
 1750:                         (*s_objet_argument_2).objet)).tableau)[i])
 1751:                         ? d_faux : d_vrai;
 1752:             }
 1753: 
 1754:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1755:                         d_faux) ? -1 : 0;
 1756:         }
 1757:     }
 1758: 
 1759:     /*
 1760:      * Vecteurs de réels
 1761:      */
 1762: 
 1763:     else if (((*s_objet_argument_1).type == VRL) &&
 1764:             ((*s_objet_argument_2).type == VRL))
 1765:     {
 1766:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1767:         {
 1768:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1769:             return;
 1770:         }
 1771: 
 1772:         if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
 1773:                 (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
 1774:         {
 1775:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1776:         }
 1777:         else
 1778:         {
 1779:             difference = d_faux;
 1780: 
 1781:             for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
 1782:                     .taille) && (difference == d_faux); i++)
 1783:             {
 1784:                 difference = (((real8 *) (*((struct_vecteur *)
 1785:                         (*s_objet_argument_1).objet)).tableau)[i] ==
 1786:                         ((real8 *) (*((struct_vecteur *)
 1787:                         (*s_objet_argument_2).objet)).tableau)[i])
 1788:                         ? d_faux : d_vrai;
 1789:             }
 1790: 
 1791:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1792:                         d_faux) ? -1 : 0;
 1793:         }
 1794:     }
 1795: 
 1796:     /*
 1797:      * Vecteurs de complexes
 1798:      */
 1799: 
 1800:     else if (((*s_objet_argument_1).type == VCX) &&
 1801:             ((*s_objet_argument_2).type == VCX))
 1802:     {
 1803:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1804:         {
 1805:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1806:             return;
 1807:         }
 1808: 
 1809:         if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
 1810:                 (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
 1811:         {
 1812:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1813:         }
 1814:         else
 1815:         {
 1816:             difference = d_faux;
 1817: 
 1818:             for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
 1819:                     .taille) && (difference == d_faux); i++)
 1820:             {
 1821:                 difference = ((((struct_complexe16 *) (*((struct_vecteur *)
 1822:                         (*s_objet_argument_1).objet)).tableau)[i].partie_reelle
 1823:                         == ((struct_complexe16 *) (*((struct_vecteur *)
 1824:                         (*s_objet_argument_2).objet)).tableau)[i].partie_reelle)
 1825:                         && (((struct_complexe16 *) (*((struct_vecteur *)
 1826:                         (*s_objet_argument_1).objet)).tableau)[i]
 1827:                         .partie_imaginaire == ((struct_complexe16 *)
 1828:                         (*((struct_vecteur *) (*s_objet_argument_2).objet))
 1829:                         .tableau)[i].partie_imaginaire)) ? d_faux : d_vrai;
 1830:             }
 1831: 
 1832:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1833:                         d_faux) ? -1 : 0;
 1834:         }
 1835:     }
 1836: 
 1837: /*
 1838: --------------------------------------------------------------------------------
 1839:   SAME portant sur des matrices
 1840: --------------------------------------------------------------------------------
 1841: */
 1842:     /*
 1843:      * Matrice d'entiers
 1844:      */
 1845: 
 1846:     else if (((*s_objet_argument_1).type == MIN) &&
 1847:             ((*s_objet_argument_2).type == MIN))
 1848:     {
 1849:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1850:         {
 1851:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1852:             return;
 1853:         }
 1854: 
 1855:         if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
 1856:                 != (*((struct_matrice *) (*s_objet_argument_2).objet))
 1857:                 .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
 1858:                 .objet)).nombre_colonnes != (*((struct_matrice *)
 1859:                 (*s_objet_argument_2).objet)).nombre_colonnes))
 1860:         {
 1861:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1862:         }
 1863:         else
 1864:         {
 1865:             difference = d_faux;
 1866: 
 1867:             for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
 1868:                     .nombre_lignes) && (difference == d_faux); i++)
 1869:             {
 1870:                 for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
 1871:                         .objet)).nombre_colonnes) && (difference == d_faux);
 1872:                         j++)
 1873:                 {
 1874:                     difference = (((integer8 **) (*((struct_matrice *)
 1875:                             (*s_objet_argument_1).objet)).tableau)[i][j] ==
 1876:                             ((integer8 **) (*((struct_matrice *)
 1877:                             (*s_objet_argument_2).objet)).tableau)[i][j])
 1878:                             ? d_faux : d_vrai;
 1879:                 }
 1880:             }
 1881: 
 1882:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1883:                         d_faux) ? -1 : 0;
 1884:         }
 1885:     }
 1886: 
 1887:     /*
 1888:      * Matrice de réels
 1889:      */
 1890: 
 1891:     else if (((*s_objet_argument_1).type == MRL) &&
 1892:             ((*s_objet_argument_2).type == MRL))
 1893:     {
 1894:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1895:         {
 1896:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1897:             return;
 1898:         }
 1899: 
 1900:         if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
 1901:                 != (*((struct_matrice *) (*s_objet_argument_2).objet))
 1902:                 .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
 1903:                 .objet)).nombre_colonnes != (*((struct_matrice *)
 1904:                 (*s_objet_argument_2).objet)).nombre_colonnes))
 1905:         {
 1906:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1907:         }
 1908:         else
 1909:         {
 1910:             difference = d_faux;
 1911: 
 1912:             for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
 1913:                     .nombre_lignes) && (difference == d_faux); i++)
 1914:             {
 1915:                 for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
 1916:                         .objet)).nombre_colonnes) && (difference == d_faux);
 1917:                         j++)
 1918:                 {
 1919:                     difference = (((real8 **) (*((struct_matrice *)
 1920:                             (*s_objet_argument_1).objet)).tableau)[i][j] ==
 1921:                             ((real8 **) (*((struct_matrice *)
 1922:                             (*s_objet_argument_2).objet)).tableau)[i][j])
 1923:                             ? d_faux : d_vrai;
 1924:                 }
 1925:             }
 1926: 
 1927:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1928:                         d_faux) ? -1 : 0;
 1929:         }
 1930:     }
 1931: 
 1932:     /*
 1933:      * Matrice de complexes
 1934:      */
 1935: 
 1936:     else if (((*s_objet_argument_1).type == MCX) &&
 1937:             ((*s_objet_argument_2).type == MCX))
 1938:     {
 1939:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1940:         {
 1941:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1942:             return;
 1943:         }
 1944: 
 1945:         if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
 1946:                 != (*((struct_matrice *) (*s_objet_argument_2).objet))
 1947:                 .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
 1948:                 .objet)).nombre_colonnes != (*((struct_matrice *)
 1949:                 (*s_objet_argument_2).objet)).nombre_colonnes))
 1950:         {
 1951:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1952:         }
 1953:         else
 1954:         {
 1955:             difference = d_faux;
 1956: 
 1957:             for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
 1958:                     .nombre_lignes) && (difference == d_faux); i++)
 1959:             {
 1960:                 for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
 1961:                         .objet)).nombre_colonnes) && (difference == d_faux);
 1962:                         j++)
 1963:                 {
 1964:                     difference = ((((struct_complexe16 **) (*((struct_matrice *)
 1965:                             (*s_objet_argument_1).objet)).tableau)[i][j]
 1966:                             .partie_reelle == ((struct_complexe16 **)
 1967:                             (*((struct_matrice *) (*s_objet_argument_2).objet))
 1968:                             .tableau)[i][j].partie_reelle) &&
 1969:                             (((struct_complexe16 **) (*((struct_matrice *)
 1970:                             (*s_objet_argument_1).objet)).tableau)[i][j]
 1971:                             .partie_imaginaire == ((struct_complexe16 **)
 1972:                             (*((struct_matrice *) (*s_objet_argument_2).objet))
 1973:                             .tableau)[i][j].partie_imaginaire))
 1974:                             ? d_faux : d_vrai;
 1975:                 }
 1976:             }
 1977: 
 1978:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1979:                         d_faux) ? -1 : 0;
 1980:         }
 1981:     }
 1982: 
 1983: /*
 1984: --------------------------------------------------------------------------------
 1985:   SAME portant sur des noms (instruction "SAME")
 1986: --------------------------------------------------------------------------------
 1987: */
 1988: 
 1989:     else if (((*s_objet_argument_1).type == NOM) &&
 1990:             ((*s_objet_argument_2).type == NOM) &&
 1991:             (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
 1992:     {
 1993:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1994:         {
 1995:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1996:             return;
 1997:         }
 1998: 
 1999:         (*((integer8 *) (*s_objet_resultat).objet)) =
 2000:                 (strcmp((*((struct_nom *) (*s_objet_argument_1).objet)).nom,
 2001:                 (*((struct_nom *) (*s_objet_argument_2).objet)).nom) == 0)
 2002:                 ? -1 : 0;
 2003:     }
 2004: 
 2005: /*
 2006: --------------------------------------------------------------------------------
 2007:   SAME entre des arguments complexes (instruction '==')
 2008: --------------------------------------------------------------------------------
 2009: */
 2010: 
 2011:     /*
 2012:      * Nom ou valeur numérique / Nom ou valeur numérique
 2013:      */
 2014: 
 2015:     else if (((((*s_objet_argument_1).type == NOM) &&
 2016:             (((*s_objet_argument_2).type == NOM) ||
 2017:             ((*s_objet_argument_2).type == INT) ||
 2018:             ((*s_objet_argument_2).type == REL))) ||
 2019:             (((*s_objet_argument_2).type == NOM) &&
 2020:             (((*s_objet_argument_1).type == INT) ||
 2021:             ((*s_objet_argument_1).type == REL)))) &&
 2022:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0))
 2023:     {
 2024:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 2025:         {
 2026:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2027:             return;
 2028:         }
 2029: 
 2030:         if (((*s_objet_resultat).objet =
 2031:                 allocation_maillon(s_etat_processus)) == NULL)
 2032:         {
 2033:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2034:             return;
 2035:         }
 2036: 
 2037:         l_element_courant = (*s_objet_resultat).objet;
 2038: 
 2039:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2040:                 == NULL)
 2041:         {
 2042:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2043:             return;
 2044:         }
 2045: 
 2046:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2047:                 .nombre_arguments = 0;
 2048:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2049:                 .fonction = instruction_vers_niveau_superieur;
 2050: 
 2051:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2052:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2053:         {
 2054:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2055:             return;
 2056:         }
 2057: 
 2058:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2059:                 .nom_fonction, "<<");
 2060: 
 2061:         if (((*l_element_courant).suivant =
 2062:                 allocation_maillon(s_etat_processus)) == NULL)
 2063:         {
 2064:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2065:             return;
 2066:         }
 2067: 
 2068:         l_element_courant = (*l_element_courant).suivant;
 2069:         (*l_element_courant).donnee = s_objet_argument_2;
 2070: 
 2071:         if (((*l_element_courant).suivant =
 2072:                 allocation_maillon(s_etat_processus)) == NULL)
 2073:         {
 2074:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2075:             return;
 2076:         }
 2077: 
 2078:         l_element_courant = (*l_element_courant).suivant;
 2079:         (*l_element_courant).donnee = s_objet_argument_1;
 2080: 
 2081:         if (((*l_element_courant).suivant =
 2082:                 allocation_maillon(s_etat_processus)) == NULL)
 2083:         {
 2084:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2085:             return;
 2086:         }
 2087: 
 2088:         l_element_courant = (*l_element_courant).suivant;
 2089: 
 2090:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2091:                 == NULL)
 2092:         {
 2093:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2094:             return;
 2095:         }
 2096: 
 2097:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2098:                 .nombre_arguments = 0;
 2099:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2100:                 .fonction = instruction_same;
 2101: 
 2102:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2103:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2104:         {
 2105:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2106:             return;
 2107:         }
 2108: 
 2109:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2110:                 .nom_fonction, "==");
 2111: 
 2112:         if (((*l_element_courant).suivant =
 2113:                 allocation_maillon(s_etat_processus)) == NULL)
 2114:         {
 2115:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2116:             return;
 2117:         }
 2118: 
 2119:         l_element_courant = (*l_element_courant).suivant;
 2120: 
 2121:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2122:                 == NULL)
 2123:         {
 2124:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2125:             return;
 2126:         }
 2127: 
 2128:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2129:                 .nombre_arguments = 0;
 2130:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2131:                 .fonction = instruction_vers_niveau_inferieur;
 2132: 
 2133:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2134:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2135:         {
 2136:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2137:             return;
 2138:         }
 2139: 
 2140:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2141:                 .nom_fonction, ">>");
 2142: 
 2143:         (*l_element_courant).suivant = NULL;
 2144: 
 2145:         s_objet_argument_1 = NULL;
 2146:         s_objet_argument_2 = NULL;
 2147:     }
 2148: 
 2149:     /*
 2150:      * Nom ou valeur numérique / Expression
 2151:      */
 2152: 
 2153:     else if (((((*s_objet_argument_1).type == ALG) ||
 2154:             ((*s_objet_argument_1).type == RPN)) &&
 2155:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) &&
 2156:             (((*s_objet_argument_2).type == NOM) ||
 2157:             ((*s_objet_argument_2).type == INT) ||
 2158:             ((*s_objet_argument_2).type == REL)))
 2159:     {
 2160:         nombre_elements = 0;
 2161:         l_element_courant = (struct_liste_chainee *)
 2162:                 (*s_objet_argument_1).objet;
 2163: 
 2164:         while(l_element_courant != NULL)
 2165:         {
 2166:             nombre_elements++;
 2167:             l_element_courant = (*l_element_courant).suivant;
 2168:         }
 2169: 
 2170:         if (nombre_elements == 2)
 2171:         {
 2172:             liberation(s_etat_processus, s_objet_argument_1);
 2173:             liberation(s_etat_processus, s_objet_argument_2);
 2174: 
 2175:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2176:             return;
 2177:         }
 2178: 
 2179:         if ((s_objet_resultat = copie_objet(s_etat_processus,
 2180:                 s_objet_argument_1, 'N')) == NULL)
 2181:         {
 2182:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2183:             return;
 2184:         }
 2185: 
 2186:         l_element_courant = (struct_liste_chainee *)
 2187:                 (*s_objet_resultat).objet;
 2188:         l_element_precedent = l_element_courant;
 2189:         l_element_courant = (*l_element_courant).suivant;
 2190: 
 2191:         if (((*l_element_precedent).suivant =
 2192:                 allocation_maillon(s_etat_processus)) == NULL)
 2193:         {
 2194:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2195:             return;
 2196:         }
 2197: 
 2198:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
 2199:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2200: 
 2201:         while((*l_element_courant).suivant != NULL)
 2202:         {
 2203:             l_element_precedent = l_element_courant;
 2204:             l_element_courant = (*l_element_courant).suivant;
 2205:         }
 2206: 
 2207:         if (((*l_element_precedent).suivant =
 2208:                 allocation_maillon(s_etat_processus)) == NULL)
 2209:         {
 2210:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2211:             return;
 2212:         }
 2213: 
 2214:         if (((*(*l_element_precedent).suivant).donnee =
 2215:                 allocation(s_etat_processus, FCT)) == NULL)
 2216:         {
 2217:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2218:             return;
 2219:         }
 2220: 
 2221:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2222:                 .donnee).objet)).nombre_arguments = 0;
 2223:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2224:                 .donnee).objet)).fonction = instruction_same;
 2225: 
 2226:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2227:                 .suivant).donnee).objet)).nom_fonction =
 2228:                 malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
 2229:                 sizeof(unsigned char))) == NULL)
 2230:         {
 2231:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2232:             return;
 2233:         }
 2234: 
 2235:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2236:                 .suivant).donnee).objet)).nom_fonction,
 2237:                 (*s_etat_processus).instruction_courante);
 2238: 
 2239:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2240: 
 2241:         s_objet_argument_2 = NULL;
 2242:     }
 2243: 
 2244:     /*
 2245:      * Expression / Nom ou valeur numérique
 2246:      */
 2247: 
 2248:     else if ((((*s_objet_argument_1).type == NOM) ||
 2249:             ((*s_objet_argument_1).type == INT) ||
 2250:             ((*s_objet_argument_1).type == REL)) &&
 2251:             ((((*s_objet_argument_2).type == ALG) ||
 2252:             ((*s_objet_argument_2).type == RPN)) &&
 2253:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0)))
 2254:     {
 2255:         nombre_elements = 0;
 2256:         l_element_courant = (struct_liste_chainee *)
 2257:                 (*s_objet_argument_2).objet;
 2258: 
 2259:         while(l_element_courant != NULL)
 2260:         {
 2261:             nombre_elements++;
 2262:             l_element_courant = (*l_element_courant).suivant;
 2263:         }
 2264: 
 2265:         if (nombre_elements == 2)
 2266:         {
 2267:             liberation(s_etat_processus, s_objet_argument_1);
 2268:             liberation(s_etat_processus, s_objet_argument_2);
 2269: 
 2270:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2271:             return;
 2272:         }
 2273: 
 2274:         if ((s_objet_resultat = copie_objet(s_etat_processus,
 2275:                 s_objet_argument_2, 'N')) == NULL)
 2276:         {
 2277:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2278:             return;
 2279:         }
 2280: 
 2281:         l_element_courant = (struct_liste_chainee *)
 2282:                 (*s_objet_resultat).objet;
 2283:         l_element_precedent = l_element_courant;
 2284: 
 2285:         while((*l_element_courant).suivant != NULL)
 2286:         {
 2287:             l_element_precedent = l_element_courant;
 2288:             l_element_courant = (*l_element_courant).suivant;
 2289:         }
 2290: 
 2291:         if (((*l_element_precedent).suivant =
 2292:                 allocation_maillon(s_etat_processus)) == NULL)
 2293:         {
 2294:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2295:             return;
 2296:         }
 2297: 
 2298:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
 2299:         l_element_precedent = (*l_element_precedent).suivant;
 2300: 
 2301:         if (((*l_element_precedent).suivant =
 2302:                 allocation_maillon(s_etat_processus)) == NULL)
 2303:         {
 2304:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2305:             return;
 2306:         }
 2307: 
 2308:         if (((*(*l_element_precedent).suivant).donnee =
 2309:                 allocation(s_etat_processus, FCT)) == NULL)
 2310:         {
 2311:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2312:             return;
 2313:         }
 2314: 
 2315:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2316:                 .donnee).objet)).nombre_arguments = 0;
 2317:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2318:                 .donnee).objet)).fonction = instruction_same;
 2319: 
 2320:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2321:                 .suivant).donnee).objet)).nom_fonction =
 2322:                 malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
 2323:                 sizeof(unsigned char))) == NULL)
 2324:         {
 2325:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2326:             return;
 2327:         }
 2328: 
 2329:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2330:                 .suivant).donnee).objet)).nom_fonction,
 2331:                 (*s_etat_processus).instruction_courante);
 2332: 
 2333:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2334: 
 2335:         s_objet_argument_1 = NULL;
 2336:     }
 2337: 
 2338:     /*
 2339:      * Expression / Expression
 2340:      */
 2341: 
 2342:     else if ((((*s_objet_argument_1).type == ALG) &&
 2343:             ((*s_objet_argument_2).type == ALG) &&
 2344:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) ||
 2345:             (((*s_objet_argument_1).type == RPN) &&
 2346:             ((*s_objet_argument_2).type == RPN)))
 2347:     {
 2348:         nombre_elements = 0;
 2349:         l_element_courant = (struct_liste_chainee *)
 2350:                 (*s_objet_argument_1).objet;
 2351: 
 2352:         while(l_element_courant != NULL)
 2353:         {
 2354:             nombre_elements++;
 2355:             l_element_courant = (*l_element_courant).suivant;
 2356:         }
 2357: 
 2358:         if (nombre_elements == 2)
 2359:         {
 2360:             liberation(s_etat_processus, s_objet_argument_1);
 2361:             liberation(s_etat_processus, s_objet_argument_2);
 2362: 
 2363:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2364:             return;
 2365:         }
 2366: 
 2367:         nombre_elements = 0;
 2368:         l_element_courant = (struct_liste_chainee *)
 2369:                 (*s_objet_argument_2).objet;
 2370: 
 2371:         while(l_element_courant != NULL)
 2372:         {
 2373:             nombre_elements++;
 2374:             l_element_courant = (*l_element_courant).suivant;
 2375:         }
 2376: 
 2377:         if (nombre_elements == 2)
 2378:         {
 2379:             liberation(s_etat_processus, s_objet_argument_1);
 2380:             liberation(s_etat_processus, s_objet_argument_2);
 2381: 
 2382:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2383:             return;
 2384:         }
 2385: 
 2386:         if ((s_copie_argument_1 = copie_objet(s_etat_processus,
 2387:                 s_objet_argument_1, 'N')) == NULL)
 2388:         {
 2389:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2390:             return;
 2391:         }
 2392: 
 2393:         if ((s_copie_argument_2 = copie_objet(s_etat_processus,
 2394:                 s_objet_argument_2, 'N')) == NULL)
 2395:         {
 2396:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2397:             return;
 2398:         }
 2399: 
 2400:         l_element_courant = (struct_liste_chainee *)
 2401:                 (*s_copie_argument_1).objet;
 2402:         (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
 2403:                 (*s_copie_argument_1).objet)).suivant;
 2404: 
 2405:         liberation(s_etat_processus, (*l_element_courant).donnee);
 2406:         free(l_element_courant);
 2407: 
 2408:         l_element_courant = (struct_liste_chainee *)
 2409:                 (*s_copie_argument_2).objet;
 2410:         l_element_precedent = l_element_courant;
 2411:         s_objet_resultat = s_copie_argument_2;
 2412: 
 2413:         while((*l_element_courant).suivant != NULL)
 2414:         {
 2415:             l_element_precedent = l_element_courant;
 2416:             l_element_courant = (*l_element_courant).suivant;
 2417:         }
 2418: 
 2419:         liberation(s_etat_processus, (*l_element_courant).donnee);
 2420:         free(l_element_courant);
 2421: 
 2422:         (*l_element_precedent).suivant = (struct_liste_chainee *)
 2423:                 (*s_copie_argument_1).objet;
 2424:         free(s_copie_argument_1);
 2425: 
 2426:         l_element_courant = (*l_element_precedent).suivant;
 2427:         while((*l_element_courant).suivant != NULL)
 2428:         {
 2429:             l_element_precedent = l_element_courant;
 2430:             l_element_courant = (*l_element_courant).suivant;
 2431:         }
 2432: 
 2433:         if (((*l_element_precedent).suivant =
 2434:                 allocation_maillon(s_etat_processus)) == NULL)
 2435:         {
 2436:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2437:             return;
 2438:         }
 2439: 
 2440:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2441:         l_element_courant = (*l_element_precedent).suivant;
 2442: 
 2443:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2444:                 == NULL)
 2445:         {
 2446:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2447:             return;
 2448:         }
 2449: 
 2450:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2451:                 .nombre_arguments = 0;
 2452:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2453:                 .fonction = instruction_same;
 2454: 
 2455:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2456:                 .nom_fonction = malloc((strlen(
 2457:                 (*s_etat_processus).instruction_courante) + 1) *
 2458:                 sizeof(unsigned char))) == NULL)
 2459:         {
 2460:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2461:             return;
 2462:         }
 2463: 
 2464:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2465:                 .nom_fonction, (*s_etat_processus).instruction_courante);
 2466:     }
 2467: 
 2468: /*
 2469: --------------------------------------------------------------------------------
 2470:   SAME nul
 2471: --------------------------------------------------------------------------------
 2472: */
 2473: 
 2474:     else
 2475:     {
 2476:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 2477:         {
 2478:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2479:             return;
 2480:         }
 2481: 
 2482:         (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 2483:     }
 2484: 
 2485:     liberation(s_etat_processus, s_objet_argument_1);
 2486:     liberation(s_etat_processus, s_objet_argument_2);
 2487: 
 2488:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2489:             s_objet_resultat) == d_erreur)
 2490:     {
 2491:         return;
 2492:     }
 2493: 
 2494:     return;
 2495: }
 2496: 
 2497: 
 2498: /*
 2499: ================================================================================
 2500:   Fonction 'start'
 2501: ================================================================================
 2502:   Entrées : structure processus
 2503: --------------------------------------------------------------------------------
 2504:   Sorties :
 2505: --------------------------------------------------------------------------------
 2506:   Effets de bord : néant
 2507: ================================================================================
 2508: */
 2509: 
 2510: void
 2511: instruction_start(struct_processus *s_etat_processus)
 2512: {
 2513:     struct_objet                            *s_objet_1;
 2514:     struct_objet                            *s_objet_2;
 2515: 
 2516:     (*s_etat_processus).erreur_execution = d_ex;
 2517: 
 2518:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2519:     {
 2520:         printf("\n  START ");
 2521: 
 2522:         if ((*s_etat_processus).langue == 'F')
 2523:         {
 2524:             printf("(boucle définie sans compteur)\n\n");
 2525:         }
 2526:         else
 2527:         {
 2528:             printf("(define a loop without counter)\n\n");
 2529:         }
 2530: 
 2531:         if ((*s_etat_processus).langue == 'F')
 2532:         {
 2533:             printf("  Utilisation :\n\n");
 2534:         }
 2535:         else
 2536:         {
 2537:             printf("  Usage:\n\n");
 2538:         }
 2539: 
 2540:         printf("    %s/%s %s/%s START\n", d_INT, d_REL,
 2541:                 d_INT, d_REL);
 2542:         printf("        (expression)\n");
 2543:         printf("        [EXIT]/[CYCLE]\n");
 2544:         printf("        ...\n");
 2545:         printf("    NEXT\n\n");
 2546: 
 2547:         printf("    %s/%s %s/%s START\n", d_INT, d_REL,
 2548:                 d_INT, d_REL);
 2549:         printf("        (expression)\n");
 2550:         printf("        [EXIT]/[CYCLE]\n");
 2551:         printf("        ...\n");
 2552:         printf("    %s/%s STEP\n", d_INT, d_REL);
 2553: 
 2554:         return;
 2555:     }
 2556:     else if ((*s_etat_processus).test_instruction == 'Y')
 2557:     {
 2558:         (*s_etat_processus).nombre_arguments = -1;
 2559:         return;
 2560:     }
 2561: 
 2562:     if ((*s_etat_processus).erreur_systeme != d_es)
 2563:     {
 2564:         return;
 2565:     }
 2566: 
 2567:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2568:     {
 2569:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 2570:         {
 2571:             return;
 2572:         }
 2573:     }
 2574: 
 2575:     empilement_pile_systeme(s_etat_processus);
 2576: 
 2577:     if ((*s_etat_processus).erreur_systeme != d_es)
 2578:     {
 2579:         return;
 2580:     }
 2581: 
 2582:     (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'S';
 2583: 
 2584:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2585:             &s_objet_1) == d_erreur)
 2586:     {
 2587:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2588:         return;
 2589:     }
 2590: 
 2591:     if (((*s_objet_1).type != INT) && ((*s_objet_1).type != REL))
 2592:     {
 2593:         liberation(s_etat_processus, s_objet_1);
 2594: 
 2595:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2596:         return;
 2597:     }
 2598: 
 2599:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2600:             &s_objet_2) == d_erreur)
 2601:     {
 2602:         liberation(s_etat_processus, s_objet_1);
 2603: 
 2604:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2605:         return;
 2606:     }
 2607: 
 2608:     if (((*s_objet_2).type != INT) && ((*s_objet_2).type != REL))
 2609:     {
 2610:         liberation(s_etat_processus, s_objet_1);
 2611:         liberation(s_etat_processus, s_objet_2);
 2612: 
 2613:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2614:         return;
 2615:     }
 2616: 
 2617:     (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet_2;
 2618:     (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
 2619: 
 2620:     if ((*s_etat_processus).mode_execution_programme == 'Y')
 2621:     {
 2622:         (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
 2623:                 (*s_etat_processus).position_courante;
 2624:         (*(*s_etat_processus).l_base_pile_systeme)
 2625:                 .origine_routine_evaluation = 'N';
 2626:     }
 2627:     else
 2628:     {
 2629:         (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
 2630:                 (*s_etat_processus).expression_courante;
 2631:         (*(*s_etat_processus).l_base_pile_systeme)
 2632:                 .origine_routine_evaluation = 'Y';
 2633:     }
 2634: 
 2635:     return;
 2636: }
 2637: 
 2638: 
 2639: /*
 2640: ================================================================================
 2641:   Fonction 'step'
 2642: ================================================================================
 2643:   Entrées : structure processus
 2644: --------------------------------------------------------------------------------
 2645:   Sorties :
 2646: --------------------------------------------------------------------------------
 2647:   Effets de bord : néant
 2648: ================================================================================
 2649: */
 2650: 
 2651: void
 2652: instruction_step(struct_processus *s_etat_processus)
 2653: {
 2654:     struct_objet                *s_objet;
 2655:     struct_objet                *s_copie_objet;
 2656: 
 2657:     logical1                    incrementation;
 2658:     logical1                    presence_compteur;
 2659: 
 2660:     (*s_etat_processus).erreur_execution = d_ex;
 2661: 
 2662:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2663:     {
 2664:         printf("\n  STEP ");
 2665: 
 2666:         if ((*s_etat_processus).langue == 'F')
 2667:         {
 2668:             printf("(fin d'une boucle définie)\n\n");
 2669:         }
 2670:         else
 2671:         {
 2672:             printf("(end of defined loop)\n\n");
 2673:         }
 2674: 
 2675:         if ((*s_etat_processus).langue == 'F')
 2676:         {
 2677:             printf("  Utilisation :\n\n");
 2678:         }
 2679:         else
 2680:         {
 2681:             printf("  Usage:\n\n");
 2682:         }
 2683: 
 2684:         printf("    %s/%s %s/%s START\n", d_INT, d_REL,
 2685:                 d_INT, d_REL);
 2686:         printf("        (expression)\n");
 2687:         printf("        [EXIT]/[CYCLE]\n");
 2688:         printf("        ...\n");
 2689:         printf("    (value) STEP\n\n");
 2690: 
 2691:         printf("    %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
 2692:                 d_INT, d_REL);
 2693:         printf("        (expression)\n");
 2694:         printf("        [EXIT]/[CYCLE]\n");
 2695:         printf("        ...\n");
 2696:         printf("    (value) STEP\n");
 2697: 
 2698:         return;
 2699:     }
 2700:     else if ((*s_etat_processus).test_instruction == 'Y')
 2701:     {
 2702:         (*s_etat_processus).nombre_arguments = -1;
 2703:         return;
 2704:     }
 2705: 
 2706:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2707:     {
 2708:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 2709:         {
 2710:             return;
 2711:         }
 2712:     }
 2713: 
 2714:     presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)
 2715:             .type_cloture == 'F') ? d_vrai : d_faux;
 2716: 
 2717:     if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
 2718:             && (presence_compteur == d_faux))
 2719:     {
 2720:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2721:         return;
 2722:     }
 2723: 
 2724:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2725:             &s_objet) == d_erreur)
 2726:     {
 2727:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2728:         return;
 2729:     }
 2730: 
 2731:     if (((*s_objet).type != INT) &&
 2732:             ((*s_objet).type != REL))
 2733:     {
 2734:         liberation(s_etat_processus, s_objet);
 2735: 
 2736:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2737:         return;
 2738:     }
 2739:     
 2740:     if ((*s_objet).type == INT)
 2741:     {
 2742:         incrementation = ((*((integer8 *) (*s_objet).objet)) >= 0)
 2743:                 ? d_vrai : d_faux;
 2744:     }
 2745:     else
 2746:     {
 2747:         incrementation = ((*((real8 *) (*s_objet).objet)) >= 0)
 2748:                 ? d_vrai : d_faux;
 2749:     }
 2750: 
 2751:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2752:             s_objet) == d_erreur)
 2753:     {
 2754:         return;
 2755:     }
 2756: 
 2757:     /*
 2758:      * Pour une boucle avec indice, on fait pointer
 2759:      * (*(*s_etat_processus).l_base_pile_systeme).indice_boucle sur
 2760:      * la variable correspondante. Remarque, le contenu de la variable
 2761:      * est détruit au courant de l'opération.
 2762:      */
 2763: 
 2764:     if (presence_compteur == d_vrai)
 2765:     {
 2766:         if (recherche_variable(s_etat_processus, (*(*s_etat_processus)
 2767:                 .l_base_pile_systeme).nom_variable) == d_faux)
 2768:         {
 2769:             liberation(s_etat_processus, s_objet);
 2770: 
 2771:             (*s_etat_processus).erreur_systeme = d_es;
 2772:             (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
 2773:             return;
 2774:         }
 2775: 
 2776:         if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2777:                 .position_variable_courante]).variable_verrouillee == d_vrai)
 2778:         {
 2779:             liberation(s_etat_processus, s_objet);
 2780: 
 2781:             (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
 2782:             return;
 2783:         }
 2784:     
 2785:         if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2786:                 .position_variable_courante]).objet == NULL)
 2787:         {
 2788:             liberation(s_etat_processus, s_objet);
 2789: 
 2790:             (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
 2791:             return;
 2792:         }
 2793: 
 2794:         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
 2795:                 ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2796:                 .position_variable_courante]).objet;
 2797:     }
 2798: 
 2799:     /*
 2800:      * Empilement pour calculer le nouvel indice. Au passage, la
 2801:      * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle
 2802:      * est libérée.
 2803:      */
 2804: 
 2805:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2806:             (*(*s_etat_processus).l_base_pile_systeme).indice_boucle)
 2807:             == d_erreur)
 2808:     {
 2809:         return;
 2810:     }
 2811: 
 2812:     instruction_plus(s_etat_processus);
 2813: 
 2814:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2815:             &s_objet) == d_erreur)
 2816:     {
 2817:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2818:         return;
 2819:     }
 2820: 
 2821:     if (((*s_objet).type != INT) &&
 2822:             ((*s_objet).type != REL))
 2823:     {
 2824:         liberation(s_etat_processus, s_objet);
 2825: 
 2826:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2827:         return;
 2828:     }
 2829:     
 2830:     if (presence_compteur == d_vrai)
 2831:     {
 2832:         /*
 2833:          * L'addition crée si besoin une copie de l'objet
 2834:          */
 2835: 
 2836:         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
 2837:         ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2838:                 .position_variable_courante]).objet = s_objet;
 2839:     }
 2840:     else
 2841:     {
 2842:         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet;
 2843:     }
 2844: 
 2845:     if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'P')) == NULL)
 2846:     {
 2847:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2848:         return;
 2849:     }
 2850: 
 2851:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2852:             s_copie_objet) == d_erreur)
 2853:     {
 2854:         return;
 2855:     }
 2856: 
 2857:     if ((s_copie_objet = copie_objet(s_etat_processus,
 2858:             (*(*s_etat_processus).l_base_pile_systeme)
 2859:             .limite_indice_boucle, 'P')) == NULL)
 2860:     {
 2861:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2862:         return;
 2863:     }
 2864: 
 2865:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2866:             s_copie_objet) == d_erreur)
 2867:     {
 2868:         return;
 2869:     }
 2870:     
 2871:     if (incrementation == d_vrai)
 2872:     {
 2873:         instruction_le(s_etat_processus);
 2874:     }
 2875:     else
 2876:     {
 2877:         instruction_ge(s_etat_processus);
 2878:     }
 2879: 
 2880:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2881:             &s_objet) == d_erreur)
 2882:     {
 2883:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2884:         return;
 2885:     }
 2886: 
 2887:     if ((*s_objet).type != INT)
 2888:     {
 2889:         liberation(s_etat_processus, s_objet);
 2890: 
 2891:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2892:         return;
 2893:     }
 2894: 
 2895:     if ((*((integer8 *) (*s_objet).objet)) != 0)
 2896:     {
 2897:         if ((*(*s_etat_processus).l_base_pile_systeme)
 2898:                 .origine_routine_evaluation == 'N')
 2899:         {
 2900:             (*s_etat_processus).position_courante = (*(*s_etat_processus)
 2901:                     .l_base_pile_systeme).adresse_retour;
 2902:         }
 2903:         else
 2904:         {
 2905:             (*s_etat_processus).expression_courante = (*(*s_etat_processus)
 2906:                     .l_base_pile_systeme).pointeur_objet_retour;
 2907:         }
 2908:     }
 2909:     else
 2910:     {
 2911:         depilement_pile_systeme(s_etat_processus);
 2912: 
 2913:         if ((*s_etat_processus).erreur_systeme != d_es)
 2914:         {
 2915:             return;
 2916:         }
 2917: 
 2918:         if (presence_compteur == d_vrai)
 2919:         {
 2920:             (*s_etat_processus).niveau_courant--;
 2921: 
 2922:             if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)
 2923:             {
 2924:                 return;
 2925:             }
 2926:         }
 2927:     }
 2928: 
 2929:     liberation(s_etat_processus, s_objet);
 2930: 
 2931:     return;
 2932: }
 2933: 
 2934: 
 2935: /*
 2936: ================================================================================
 2937:   Fonction 'sf'
 2938: ================================================================================
 2939:   Entrées : structure processus
 2940: --------------------------------------------------------------------------------
 2941:   Sorties :
 2942: --------------------------------------------------------------------------------
 2943:   Effets de bord : néant
 2944: ================================================================================
 2945: */
 2946: 
 2947: void
 2948: instruction_sf(struct_processus *s_etat_processus)
 2949: {
 2950:     struct_objet                            *s_objet;
 2951: 
 2952:     (*s_etat_processus).erreur_execution = d_ex;
 2953: 
 2954:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2955:     {
 2956:         printf("\n  SF ");
 2957: 
 2958:         if ((*s_etat_processus).langue == 'F')
 2959:         {
 2960:             printf("(positionne un indicateur binaire)\n\n");
 2961:         }
 2962:         else
 2963:         {
 2964:             printf("(set flag)\n\n");
 2965:         }
 2966: 
 2967:         printf("    1: 1 <= %s <= 64\n", d_INT);
 2968: 
 2969:         return;
 2970:     }
 2971:     else if ((*s_etat_processus).test_instruction == 'Y')
 2972:     {
 2973:         (*s_etat_processus).nombre_arguments = -1;
 2974:         return;
 2975:     }
 2976: 
 2977:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2978:     {
 2979:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 2980:         {
 2981:             return;
 2982:         }
 2983:     }
 2984: 
 2985:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2986:             &s_objet) == d_erreur)
 2987:     {
 2988:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2989:         return;
 2990:     }
 2991: 
 2992:     if ((*s_objet).type == INT)
 2993:     {
 2994:         if (((*((integer8 *) (*s_objet).objet)) < 1) || ((*((integer8 *)
 2995:                 (*s_objet).objet)) > 64))
 2996:         {
 2997:             liberation(s_etat_processus, s_objet);
 2998: 
 2999:             (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
 3000:             return;
 3001:         }
 3002: 
 3003:         sf(s_etat_processus, (unsigned char) (*((integer8 *)
 3004:                 (*s_objet).objet)));
 3005:     }
 3006:     else
 3007:     {
 3008:         liberation(s_etat_processus, s_objet);
 3009: 
 3010:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 3011:         return;
 3012:     }
 3013: 
 3014:     liberation(s_etat_processus, s_objet);
 3015: 
 3016:     return;
 3017: }
 3018: 
 3019: 
 3020: /*
 3021: ================================================================================
 3022:   Fonction 'stof'
 3023: ================================================================================
 3024:   Entrées : structure processus
 3025: --------------------------------------------------------------------------------
 3026:   Sorties :
 3027: --------------------------------------------------------------------------------
 3028:   Effets de bord : néant
 3029: ================================================================================
 3030: */
 3031: 
 3032: void
 3033: instruction_stof(struct_processus *s_etat_processus)
 3034: {
 3035:     struct_objet                            *s_objet;
 3036: 
 3037:     t_8_bits                                masque;
 3038: 
 3039:     unsigned char                           indice_bit;
 3040:     unsigned char                           indice_bloc;
 3041:     unsigned char                           indice_drapeau;
 3042:     unsigned char                           taille_bloc;
 3043: 
 3044:     unsigned long                           i;
 3045: 
 3046:     (*s_etat_processus).erreur_execution = d_ex;
 3047: 
 3048:     if ((*s_etat_processus).affichage_arguments == 'Y')
 3049:     {
 3050:         printf("\n  STOF ");
 3051: 
 3052:         if ((*s_etat_processus).langue == 'F')
 3053:         {
 3054:             printf("(positionne les drapeaux d'état)\n\n");
 3055:         }
 3056:         else
 3057:         {
 3058:             printf("(set flags)\n\n");
 3059:         }
 3060: 
 3061:         printf("->  1: %s\n", d_BIN);
 3062: 
 3063:         return;
 3064:     }
 3065:     else if ((*s_etat_processus).test_instruction == 'Y')
 3066:     {
 3067:         (*s_etat_processus).nombre_arguments = -1;
 3068:         return;
 3069:     }
 3070:     
 3071:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 3072:     {
 3073:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 3074:         {
 3075:             return;
 3076:         }
 3077:     }
 3078: 
 3079:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3080:             &s_objet) == d_erreur)
 3081:     {
 3082:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3083:         return;
 3084:     }
 3085: 
 3086:     if ((*s_objet).type == BIN)
 3087:     {
 3088:         taille_bloc = sizeof(t_8_bits) * 8;
 3089: 
 3090:         for(i = 0; i < 8; (*s_etat_processus).drapeaux_etat[i++] = 0);
 3091: 
 3092:         for(i = 1; i <= 64; i++)
 3093:         {
 3094:             indice_drapeau = i - 1;
 3095:             indice_bloc = indice_drapeau / taille_bloc;
 3096:             indice_bit = indice_drapeau % taille_bloc;
 3097:             masque = ((t_8_bits) 1) << (taille_bloc - indice_bit - 1);
 3098: 
 3099:             if (((*((logical8 *) (*s_objet).objet)) &
 3100:                     ((logical8) 1) << indice_drapeau) != 0)
 3101:             {
 3102:                 (*s_etat_processus).drapeaux_etat[indice_bloc] |= masque;
 3103:             }
 3104:         }
 3105:     }
 3106:     else
 3107:     {
 3108:         liberation(s_etat_processus, s_objet);
 3109: 
 3110:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 3111:         return;
 3112:     }
 3113: 
 3114:     liberation(s_etat_processus, s_objet);
 3115: 
 3116:     return;
 3117: }
 3118: 
 3119: 
 3120: /*
 3121: ================================================================================
 3122:   Fonction 'sto'
 3123: ================================================================================
 3124:   Entrées : structure processus
 3125: --------------------------------------------------------------------------------
 3126:   Sorties :
 3127: --------------------------------------------------------------------------------
 3128:   Effets de bord : néant
 3129: ================================================================================
 3130: */
 3131: 
 3132: void
 3133: instruction_sto(struct_processus *s_etat_processus)
 3134: {
 3135:     struct_objet                        *s_objet_1;
 3136:     struct_objet                        *s_objet_2;
 3137: 
 3138:     struct_variable                     s_variable;
 3139: 
 3140:     (*s_etat_processus).erreur_execution = d_ex;
 3141: 
 3142:     if ((*s_etat_processus).affichage_arguments == 'Y')
 3143:     {
 3144:         printf("\n  STO ");
 3145: 
 3146:         if ((*s_etat_processus).langue == 'F')
 3147:         {
 3148:             printf("(affecte un objet à une variable)\n\n");
 3149:         }
 3150:         else
 3151:         {
 3152:             printf("(store an object in a variable)\n\n");
 3153:         }
 3154: 
 3155:         printf("    2: %s, %s, %s, %s, %s, %s,\n"
 3156:                 "       %s, %s, %s, %s, %s,\n"
 3157:                 "       %s, %s, %s, %s, %s,\n"
 3158:                 "       %s, %s, %s, %s, %s,\n"
 3159:                 "       %s\n",
 3160:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 3161:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
 3162:                 d_SLB, d_PRC, d_MTX, d_SQL);
 3163:         printf("    1: %s\n", d_NOM);
 3164: 
 3165:         return;
 3166:     }
 3167:     else if ((*s_etat_processus).test_instruction == 'Y')
 3168:     {
 3169:         (*s_etat_processus).nombre_arguments = -1;
 3170:         return;
 3171:     }
 3172:     
 3173:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 3174:     {
 3175:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 3176:         {
 3177:             return;
 3178:         }
 3179:     }
 3180: 
 3181:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3182:             &s_objet_1) == d_erreur)
 3183:     {
 3184:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3185:         return;
 3186:     }
 3187: 
 3188:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3189:             &s_objet_2) == d_erreur)
 3190:     {
 3191:         liberation(s_etat_processus, s_objet_1);
 3192: 
 3193:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3194:         return;
 3195:     }
 3196: 
 3197:     if ((*s_objet_1).type != NOM)
 3198:     {
 3199:         liberation(s_etat_processus, s_objet_1);
 3200:         liberation(s_etat_processus, s_objet_2);
 3201: 
 3202:         (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
 3203:         return;
 3204:     }
 3205: 
 3206:     if (recherche_variable(s_etat_processus, (*((struct_nom *)
 3207:             (*s_objet_1).objet)).nom) == d_vrai)
 3208:     {
 3209:         /*
 3210:          * La variable est accessible.
 3211:          */
 3212: 
 3213:         if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3214:                 .position_variable_courante].variable_verrouillee == d_vrai)
 3215:         {
 3216:             liberation(s_etat_processus, s_objet_1);
 3217:             liberation(s_etat_processus, s_objet_2);
 3218: 
 3219:             (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
 3220:             return;
 3221:         }
 3222: 
 3223:         if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3224:                 .position_variable_courante].objet == NULL)
 3225:         {
 3226:             if (pthread_mutex_lock(&((*(*s_etat_processus)
 3227:                     .s_liste_variables_partagees).mutex)) != 0)
 3228:             {
 3229:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3230:                 return;
 3231:             }
 3232: 
 3233:             if (recherche_variable_partagee(s_etat_processus,
 3234:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3235:                     .position_variable_courante].nom,
 3236:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3237:                     .position_variable_courante].variable_partagee,
 3238:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3239:                     .position_variable_courante].origine) == d_faux)
 3240:             {
 3241:                 if (pthread_mutex_unlock(&((*(*s_etat_processus)
 3242:                         .s_liste_variables_partagees).mutex)) != 0)
 3243:                 {
 3244:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3245:                     return;
 3246:                 }
 3247: 
 3248:                 if ((*s_etat_processus).autorisation_nom_implicite == 'N')
 3249:                 {
 3250:                     liberation(s_etat_processus, s_objet_1);
 3251:                     liberation(s_etat_processus, s_objet_2);
 3252: 
 3253:                     (*s_etat_processus).erreur_systeme = d_es;
 3254:                     (*s_etat_processus).erreur_execution =
 3255:                             d_ex_creation_variable_globale;
 3256:                     return;
 3257:                 }
 3258: 
 3259:                 if ((s_variable.nom = malloc((strlen((*((struct_nom *)
 3260:                         (*s_objet_1).objet)).nom) + 1) *
 3261:                         sizeof(unsigned char))) == NULL)
 3262:                 {
 3263:                     (*s_etat_processus).erreur_systeme =
 3264:                             d_es_allocation_memoire;
 3265:                     return;
 3266:                 }
 3267: 
 3268:                 strcpy(s_variable.nom, (*((struct_nom *)
 3269:                         (*s_objet_1).objet)).nom);
 3270:                 s_variable.niveau = 1;
 3271: 
 3272:                 /*
 3273:                  * Le niveau 0 correspond aux définitions. Les variables
 3274:                  * commencent à 1 car elles sont toujours incluses dans
 3275:                  * une définition.
 3276:                  */
 3277: 
 3278:                 s_variable.objet = s_objet_2;
 3279: 
 3280:                 if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 3281:                         == d_erreur)
 3282:                 {
 3283:                     return;
 3284:                 }
 3285: 
 3286:                 (*s_etat_processus).erreur_systeme = d_es;
 3287:             }
 3288:             else
 3289:             {
 3290:                 liberation(s_etat_processus, (*(*s_etat_processus)
 3291:                         .s_liste_variables_partagees).table
 3292:                         [(*(*s_etat_processus).s_liste_variables_partagees)
 3293:                         .position_variable].objet);
 3294: 
 3295:                 (*(*s_etat_processus).s_liste_variables_partagees).table
 3296:                         [(*(*s_etat_processus).s_liste_variables_partagees)
 3297:                         .position_variable].objet = s_objet_2;
 3298: 
 3299:                 if (pthread_mutex_unlock(&((*(*s_etat_processus)
 3300:                         .s_liste_variables_partagees).mutex)) != 0)
 3301:                 {
 3302:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3303:                     return;
 3304:                 }
 3305:             }
 3306:         }
 3307:         else
 3308:         {
 3309:             if ((*s_etat_processus).autorisation_nom_implicite == 'N')
 3310:             {
 3311:                 if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3312:                         .position_variable_courante].niveau == 1)
 3313:                 {
 3314:                     liberation(s_etat_processus, s_objet_1);
 3315:                     liberation(s_etat_processus, s_objet_2);
 3316: 
 3317:                     (*s_etat_processus).erreur_execution =
 3318:                             d_ex_creation_variable_globale;
 3319:                     return;
 3320:                 }
 3321:             }
 3322: 
 3323:             liberation(s_etat_processus,
 3324:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3325:                     .position_variable_courante].objet);
 3326: 
 3327:             (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3328:                     .position_variable_courante].objet = s_objet_2;
 3329:         }
 3330:     }
 3331:     else
 3332:     {
 3333:         /*
 3334:          * La variable n'est pas accessible ou n'existe pas et on crée
 3335:          * une variable globale.
 3336:          */
 3337: 
 3338:         if ((*s_etat_processus).autorisation_nom_implicite == 'N')
 3339:         {
 3340:             liberation(s_etat_processus, s_objet_1);
 3341:             liberation(s_etat_processus, s_objet_2);
 3342: 
 3343:             (*s_etat_processus).erreur_systeme = d_es;
 3344:             (*s_etat_processus).erreur_execution =
 3345:                     d_ex_creation_variable_globale;
 3346:             return;
 3347:         }
 3348: 
 3349:         if ((s_variable.nom = malloc((strlen((*((struct_nom *)
 3350:                 (*s_objet_1).objet)).nom) + 1) * sizeof(unsigned char)))
 3351:                 == NULL)
 3352:         {
 3353:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 3354:             return;
 3355:         }
 3356: 
 3357:         strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_1).objet)).nom);
 3358:         s_variable.niveau = 1;
 3359: 
 3360:         /*
 3361:          * Le niveau 0 correspond aux définitions. Les variables
 3362:          * commencent à 1 car elles sont toujours incluses dans
 3363:          * une définition.
 3364:          */
 3365: 
 3366:         s_variable.objet = s_objet_2;
 3367: 
 3368:         if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 3369:                 == d_erreur)
 3370:         {
 3371:             return;
 3372:         }
 3373: 
 3374:         (*s_etat_processus).erreur_systeme = d_es;
 3375:     }
 3376: 
 3377:     liberation(s_etat_processus, s_objet_1);
 3378: 
 3379:     return;
 3380: }
 3381: 
 3382: 
 3383: /*
 3384: ================================================================================
 3385:   Fonction 'syseval'
 3386: ================================================================================
 3387:   Entrées : pointeur sur une struct_processus
 3388: --------------------------------------------------------------------------------
 3389:   Sorties :
 3390: --------------------------------------------------------------------------------
 3391:   Effets de bord : néant
 3392: ================================================================================
 3393: */
 3394: 
 3395: void
 3396: instruction_syseval(struct_processus *s_etat_processus)
 3397: {
 3398:     char                        **arguments;
 3399: 
 3400:     int                         ios;
 3401:     int                         pipes_entree[2];
 3402:     int                         pipes_erreur[2];
 3403:     int                         pipes_sortie[2];
 3404:     int                         status;
 3405: 
 3406:     logical1                    drapeau_fin;
 3407:     logical1                    presence_stdin;
 3408: 
 3409:     long                        i;
 3410:     long                        nombre_arguments;
 3411: 
 3412:     pid_t                       pid;
 3413: 
 3414:     sigset_t                    oldset;
 3415:     sigset_t                    set;
 3416: 
 3417:     ssize_t                     longueur_ecriture;
 3418: 
 3419:     struct_liste_chainee        *l_element_courant;
 3420:     struct_liste_chainee        *l_element_precedent;
 3421:     struct_liste_chainee        *l_element_stdin;
 3422: 
 3423:     struct_objet                *s_objet;
 3424:     struct_objet                *s_objet_composite;
 3425:     struct_objet                *s_objet_resultat;
 3426:     struct_objet                *s_objet_temporaire;
 3427: 
 3428:     struct sigaction            action_courante;
 3429:     struct sigaction            action_passee;
 3430: 
 3431:     unsigned char               *ptr;
 3432:     unsigned char               *ptr2;
 3433:     unsigned char               registre_autorisation_empilement_programme;
 3434:     unsigned char               *registre_instruction_courante;
 3435:     unsigned char               *registre_programme;
 3436:     unsigned char               *tampon;
 3437: 
 3438:     unsigned long               longueur_lecture;
 3439:     unsigned long               longueur_tampon;
 3440:     unsigned long               nombre_iterations;
 3441:     unsigned long               nombre_lignes;
 3442:     unsigned long               pointeur;
 3443:     unsigned long               registre_position_courante;
 3444: 
 3445:     (*s_etat_processus).erreur_execution = d_ex;
 3446: 
 3447:     if ((*s_etat_processus).affichage_arguments == 'Y')
 3448:     {
 3449:         printf("\n  SYSEVAL ");
 3450: 
 3451:         if ((*s_etat_processus).langue == 'F')
 3452:         {
 3453:             printf("(exécute une commande système)\n\n");
 3454:         }
 3455:         else
 3456:         {
 3457:             printf("(execute a shell command)\n\n");
 3458:         }
 3459: 
 3460:         printf("    1: %s\n", d_CHN);
 3461:         printf("->  1: %s\n\n", d_LST);
 3462: 
 3463:         printf("    1: %s\n", d_LST);
 3464:         printf("->  1: %s\n", d_LST);
 3465: 
 3466:         return;
 3467:     }
 3468:     else if ((*s_etat_processus).test_instruction == 'Y')
 3469:     {
 3470:         (*s_etat_processus).nombre_arguments = -1;
 3471:         return;
 3472:     }
 3473:     
 3474:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 3475:     {
 3476:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 3477:         {
 3478:             return;
 3479:         }
 3480:     }
 3481: 
 3482:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3483:             &s_objet) == d_erreur)
 3484:     {
 3485:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3486:         return;
 3487:     }
 3488: 
 3489:     s_objet_composite = NULL;
 3490:     l_element_stdin = NULL;
 3491:     presence_stdin = d_faux;
 3492: 
 3493:     if ((*s_objet).type == LST)
 3494:     {
 3495:         s_objet_composite = s_objet;
 3496:         s_objet = (*((struct_liste_chainee *) (*s_objet_composite)
 3497:                 .objet)).donnee;
 3498:         l_element_stdin = (*((struct_liste_chainee *) (*s_objet_composite)
 3499:                 .objet)).suivant;
 3500: 
 3501:         l_element_courant = l_element_stdin;
 3502: 
 3503:         if (l_element_courant == NULL)
 3504:         {
 3505:             liberation(s_etat_processus, s_objet_composite);
 3506: 
 3507:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 3508:             return;
 3509:         }
 3510: 
 3511:         while(l_element_courant != NULL)
 3512:         {
 3513:             if ((*(*l_element_courant).donnee).type != CHN)
 3514:             {
 3515:                 liberation(s_etat_processus, s_objet_composite);
 3516: 
 3517:                 (*s_etat_processus).erreur_execution =
 3518:                         d_ex_erreur_type_argument;
 3519:                 return;
 3520:             }
 3521: 
 3522:             l_element_courant = (*l_element_courant).suivant;
 3523:         }
 3524: 
 3525:         presence_stdin = d_vrai;
 3526:     }
 3527: 
 3528:     if ((*s_objet).type == CHN)
 3529:     {
 3530:         registre_autorisation_empilement_programme =
 3531:                 (*s_etat_processus).autorisation_empilement_programme;
 3532:         registre_instruction_courante =
 3533:                 (*s_etat_processus).instruction_courante;
 3534:         registre_programme = (*s_etat_processus).definitions_chainees;
 3535:         registre_position_courante = (*s_etat_processus).position_courante;
 3536: 
 3537:         (*s_etat_processus).definitions_chainees =
 3538:                 (unsigned char *) (*s_objet).objet;
 3539:         (*s_etat_processus).position_courante = 0;
 3540:         (*s_etat_processus).autorisation_empilement_programme = 'N';
 3541: 
 3542:         /*
 3543:          * Échappement des guillemets
 3544:          */
 3545: 
 3546:         ptr = (*s_etat_processus).definitions_chainees;
 3547:         ptr2 = ptr;
 3548:         i = 0;
 3549: 
 3550:         while((*ptr) != d_code_fin_chaine)
 3551:         {
 3552:             if ((*ptr) == '\\')
 3553:             {
 3554:                 switch (*(ptr + 1))
 3555:                 {
 3556:                     case '"':
 3557:                     case '\\':
 3558:                     {
 3559:                         ptr++;
 3560:                         break;
 3561:                     }
 3562:                 }
 3563:             }
 3564: 
 3565:             *ptr2++ = *ptr++;
 3566:         }
 3567: 
 3568:         *ptr2 = d_code_fin_chaine;
 3569: 
 3570:         /*
 3571:          * Scission de la chaîne en différents arguments
 3572:          */
 3573: 
 3574:         nombre_arguments = 0;
 3575:         drapeau_fin = d_faux;
 3576: 
 3577:         do
 3578:         {
 3579:             if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
 3580:             {
 3581:                 (*s_etat_processus).autorisation_empilement_programme =
 3582:                         registre_autorisation_empilement_programme;
 3583:                 (*s_etat_processus).instruction_courante =
 3584:                         registre_instruction_courante;
 3585:                 (*s_etat_processus).definitions_chainees = registre_programme;
 3586:                 (*s_etat_processus).position_courante =
 3587:                         registre_position_courante;
 3588: 
 3589:                 return;
 3590:             }
 3591: 
 3592:             if ((*(*s_etat_processus).instruction_courante) !=
 3593:                     d_code_fin_chaine)
 3594:             {
 3595:                 if ((s_objet_temporaire = allocation(s_etat_processus, CHN))
 3596:                         == NULL)
 3597:                 {
 3598:                     (*s_etat_processus).autorisation_empilement_programme =
 3599:                             registre_autorisation_empilement_programme;
 3600:                     (*s_etat_processus).instruction_courante =
 3601:                             registre_instruction_courante;
 3602:                     (*s_etat_processus).definitions_chainees =
 3603:                             registre_programme;
 3604:                     (*s_etat_processus).position_courante =
 3605:                             registre_position_courante;
 3606: 
 3607:                     (*s_etat_processus).erreur_systeme =
 3608:                             d_es_allocation_memoire;
 3609:                     return;
 3610:                 }
 3611: 
 3612:                 (*s_objet_temporaire).objet = (*s_etat_processus)
 3613:                         .instruction_courante;
 3614: 
 3615:                 /*
 3616:                  * S'il y a des guillemets en début de chaîne, il y en
 3617:                  * a aussi à la fin de la chaîne et on les ôte. Les
 3618:                  * guillements intermédiaires sont protégés par une
 3619:                  * séquence d'échappement qui est enlevée.
 3620:                  */
 3621: 
 3622:                 if ((*s_etat_processus).instruction_courante[0] == '"')
 3623:                 {
 3624:                     if (strlen((*s_etat_processus).instruction_courante) >= 2)
 3625:                     {
 3626:                         ptr = (*s_etat_processus).instruction_courante;
 3627:                         ptr2 = ptr + 1;
 3628: 
 3629:                         while((*ptr2) != d_code_fin_chaine)
 3630:                         {
 3631:                             *ptr++ = *ptr2++;
 3632:                         }
 3633: 
 3634:                         (*(--ptr)) = d_code_fin_chaine;
 3635:                     }
 3636:                 }
 3637: 
 3638:                 if (empilement(s_etat_processus,
 3639:                         &((*s_etat_processus).l_base_pile),
 3640:                         s_objet_temporaire) == d_erreur)
 3641:                 {
 3642:                     return;
 3643:                 }
 3644:             }
 3645:             else
 3646:             {
 3647:                 free((*s_etat_processus).instruction_courante);
 3648:                 drapeau_fin = d_vrai;
 3649:             }
 3650: 
 3651:             nombre_arguments++;
 3652:         } while(drapeau_fin == d_faux);
 3653: 
 3654:         (*s_etat_processus).autorisation_empilement_programme =
 3655:                 registre_autorisation_empilement_programme;
 3656:         (*s_etat_processus).instruction_courante =
 3657:                 registre_instruction_courante;
 3658:         (*s_etat_processus).definitions_chainees = registre_programme;
 3659:         (*s_etat_processus).position_courante = registre_position_courante;
 3660: 
 3661:         if ((arguments = malloc(nombre_arguments * sizeof(char *))) == NULL)
 3662:         {
 3663:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 3664:             return;
 3665:         }
 3666: 
 3667:         l_element_courant = (*s_etat_processus).l_base_pile;
 3668:         nombre_arguments--;
 3669: 
 3670:         for(i = nombre_arguments, arguments[i--] = NULL; i >= 0; i--)
 3671:         {
 3672:             arguments[i] = (char *) (*(*l_element_courant).donnee).objet;
 3673:             l_element_courant = (*l_element_courant).suivant;
 3674:         }
 3675: 
 3676:         action_courante.sa_handler = SIG_IGN;
 3677:         action_courante.sa_flags = SA_NODEFER | SA_ONSTACK;
 3678: 
 3679:         if (sigaction(SIGINT, &action_courante, &action_passee) != 0)
 3680:         {
 3681:             for(i = 0; i < nombre_arguments; i++)
 3682:             {
 3683:                 depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3684:                         &s_objet_temporaire);
 3685:                 liberation(s_etat_processus, s_objet_temporaire);
 3686:             }
 3687: 
 3688:             free(arguments);
 3689:             (*s_etat_processus).erreur_systeme = d_es_signal;
 3690:             return;
 3691:         }
 3692: 
 3693:         if (pipe(pipes_entree) != 0)
 3694:         {
 3695:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3696:             return;
 3697:         }
 3698:             
 3699:         if (pipe(pipes_sortie) != 0)
 3700:         {
 3701:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3702:             return;
 3703:         }
 3704: 
 3705:         if (pipe(pipes_erreur) != 0)
 3706:         {
 3707:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3708:             return;
 3709:         }
 3710: 
 3711:         fflush(NULL);
 3712: 
 3713:         sigfillset(&set);
 3714:         pthread_sigmask(SIG_BLOCK, &set, &oldset);
 3715: 
 3716:         verrouillage_threads_concurrents(s_etat_processus);
 3717:         pid = fork();
 3718:         deverrouillage_threads_concurrents(s_etat_processus);
 3719: 
 3720:         pthread_sigmask(SIG_SETMASK, &oldset, NULL);
 3721:         sigpending(&set);
 3722: 
 3723:         if (pid < 0)
 3724:         {
 3725:             if (close(pipes_entree[0]) != 0)
 3726:             {
 3727:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3728:                 return;
 3729:             }
 3730: 
 3731:             if (close(pipes_entree[1]) != 0)
 3732:             {
 3733:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3734:                 return;
 3735:             }
 3736: 
 3737:             if (close(pipes_sortie[0]) != 0)
 3738:             {
 3739:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3740:                 return;
 3741:             }
 3742: 
 3743:             if (close(pipes_sortie[1]) != 0)
 3744:             {
 3745:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3746:                 return;
 3747:             }
 3748: 
 3749:             if (close(pipes_erreur[0]) != 0)
 3750:             {
 3751:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3752:                 return;
 3753:             }
 3754: 
 3755:             if (close(pipes_erreur[1]) != 0)
 3756:             {
 3757:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3758:                 return;
 3759:             }
 3760: 
 3761:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3762:             return;
 3763:         }
 3764:         else if (pid == 0)
 3765:         {
 3766:             if (close(pipes_entree[1]) != 0)
 3767:             {
 3768:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3769:                 return;
 3770:             }
 3771: 
 3772:             if (close(pipes_sortie[0]) != 0)
 3773:             {
 3774:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3775:                 return;
 3776:             }
 3777: 
 3778:             if (close(pipes_erreur[0]) != 0)
 3779:             {
 3780:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3781:                 return;
 3782:             }
 3783: 
 3784:             if (pipes_entree[0] != STDIN_FILENO)
 3785:             {
 3786:                 if (dup2(pipes_entree[0], STDIN_FILENO) == -1)
 3787:                 {
 3788:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3789:                     return;
 3790:                 }
 3791:             }
 3792: 
 3793:             if (pipes_sortie[1] != STDOUT_FILENO)
 3794:             {
 3795:                 if (dup2(pipes_sortie[1], STDOUT_FILENO) == -1)
 3796:                 {
 3797:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3798:                     return;
 3799:                 }
 3800:             }
 3801: 
 3802:             if (pipes_sortie[1] != STDERR_FILENO)
 3803:             {
 3804:                 if (dup2(pipes_sortie[1], STDERR_FILENO) == -1)
 3805:                 {
 3806:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3807:                     return;
 3808:                 }
 3809:             }
 3810: 
 3811:             if (nombre_arguments != 0)
 3812:             {
 3813:                 execvp(arguments[0], arguments);
 3814:             }
 3815:             else
 3816:             {
 3817:                 exit(EXIT_SUCCESS);
 3818:             }
 3819: 
 3820:             /*
 3821:              * L'appel système execvp() a généré une erreur et n'a pu exécuter
 3822:              * argument[0] (fichier non exécutable ou inexistant).
 3823:              */
 3824: 
 3825:             close(pipes_entree[0]);
 3826:             close(pipes_sortie[1]);
 3827: 
 3828:             for(i = 0; i < nombre_arguments; i++)
 3829:             {
 3830:                 depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3831:                         &s_objet_temporaire);
 3832:                 liberation(s_etat_processus, s_objet_temporaire);
 3833:             }
 3834: 
 3835:             free(arguments);
 3836:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3837: 
 3838:             /*
 3839:              * Envoi d'une erreur dans le pipe idoine. On ne regarde pas
 3840:              * le nombre d'octets écrits car l'erreur ne pourra de toute
 3841:              * façon pas être traitée.
 3842:              */
 3843: 
 3844:             write_atomic(s_etat_processus, pipes_erreur[1], " ", 1);
 3845:             close(pipes_erreur[1]);
 3846: 
 3847:             exit(EXIT_SUCCESS);
 3848:         }
 3849:         else
 3850:         {
 3851:             if (close(pipes_entree[0]) != 0)
 3852:             {
 3853:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3854:                 return;
 3855:             }
 3856: 
 3857:             if (close(pipes_sortie[1]) != 0)
 3858:             {
 3859:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3860:                 return;
 3861:             }
 3862: 
 3863:             if (close(pipes_erreur[1]) != 0)
 3864:             {
 3865:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3866:                 return;
 3867:             }
 3868: 
 3869:             if (presence_stdin == d_vrai)
 3870:             {
 3871:                 l_element_courant = l_element_stdin;
 3872: 
 3873:                 while(l_element_courant != NULL)
 3874:                 {
 3875:                     longueur_ecriture = strlen((unsigned char *)
 3876:                             (*(*l_element_courant).donnee).objet);
 3877: 
 3878: #                   ifndef SEMAPHORES_NOMMES
 3879:                     if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 3880: #                   else
 3881:                     if (sem_post((*s_etat_processus).semaphore_fork) != 0)
 3882: #                   endif
 3883:                     {
 3884:                         (*s_etat_processus).erreur_systeme = d_es_processus;
 3885:                         return;
 3886:                     }
 3887: 
 3888:                     while(write_atomic(s_etat_processus,
 3889:                             pipes_entree[1], (unsigned char *)
 3890:                             (*(*l_element_courant).donnee).objet,
 3891:                             longueur_ecriture) != longueur_ecriture)
 3892:                     {
 3893: #                       ifndef SEMAPHORES_NOMMES
 3894:                         while(sem_wait(&((*s_etat_processus)
 3895:                                 .semaphore_fork)) == -1)
 3896: #                       else
 3897:                         while(sem_wait((*s_etat_processus)
 3898:                                 .semaphore_fork) == -1)
 3899: #                       endif
 3900:                         {
 3901:                             if (errno != EINTR)
 3902:                             {
 3903:                                 (*s_etat_processus).erreur_systeme =
 3904:                                         d_es_processus;
 3905:                                 return;
 3906:                             }
 3907:                         }
 3908: 
 3909:                         if (longueur_ecriture == -1)
 3910:                         {
 3911:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3912:                             return;
 3913:                         }
 3914: 
 3915: #                       ifndef SEMAPHORES_NOMMES
 3916:                         if (sem_post(&((*s_etat_processus)
 3917:                                 .semaphore_fork)) != 0)
 3918: #                       else
 3919:                         if (sem_post((*s_etat_processus)
 3920:                                 .semaphore_fork) != 0)
 3921: #                       endif
 3922:                         {
 3923:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3924:                             return;
 3925:                         }
 3926:                     }
 3927: 
 3928:                     while(write_atomic(s_etat_processus,
 3929:                             pipes_entree[1], "\n", 1) != 1)
 3930:                     {
 3931: #                       ifndef SEMAPHORES_NOMMES
 3932:                         while(sem_wait(&((*s_etat_processus)
 3933:                                 .semaphore_fork)) == -1)
 3934: #                       else
 3935:                         while(sem_wait((*s_etat_processus)
 3936:                                 .semaphore_fork) == -1)
 3937: #                       endif
 3938:                         {
 3939:                             if (errno != EINTR)
 3940:                             {
 3941:                                 (*s_etat_processus).erreur_systeme =
 3942:                                         d_es_processus;
 3943:                                 return;
 3944:                             }
 3945:                         }
 3946: 
 3947:                         if (longueur_ecriture == -1)
 3948:                         {
 3949:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3950:                             return;
 3951:                         }
 3952: 
 3953: #                       ifndef SEMAPHORES_NOMMES
 3954:                         if (sem_post(&((*s_etat_processus)
 3955:                                 .semaphore_fork)) != 0)
 3956: #                       else
 3957:                         if (sem_post((*s_etat_processus)
 3958:                                 .semaphore_fork) != 0)
 3959: #                       endif
 3960:                         {
 3961:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3962:                             return;
 3963:                         }
 3964:                     }
 3965: 
 3966: #                   ifndef SEMAPHORES_NOMMES
 3967:                     while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 3968: #                   else
 3969:                     while(sem_wait((*s_etat_processus).semaphore_fork) == -1)
 3970: #                   endif
 3971:                     {
 3972:                         if (errno != EINTR)
 3973:                         {
 3974:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3975:                             return;
 3976:                         }
 3977:                     }
 3978: 
 3979:                     l_element_courant = (*l_element_courant).suivant;
 3980:                 }
 3981:             }
 3982: 
 3983:             if (close(pipes_entree[1]) != 0)
 3984:             {
 3985:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3986:                 return;
 3987:             }
 3988: 
 3989:             do
 3990:             {
 3991:                 if (kill(pid, 0) != 0)
 3992:                 {
 3993:                     break;
 3994:                 }
 3995: 
 3996:                 /*
 3997:                  * Récupération de la valeur de retour du processus détaché
 3998:                  */
 3999: 
 4000: #               ifndef SEMAPHORES_NOMMES
 4001:                 if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 4002: #               else
 4003:                 if (sem_post((*s_etat_processus).semaphore_fork) != 0)
 4004: #               endif
 4005:                 {
 4006:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4007:                     return;
 4008:                 }
 4009: 
 4010:                 if (waitpid(pid, &status, 0) == -1)
 4011:                 {
 4012: #                   ifndef SEMAPHORES_NOMMES
 4013:                     if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4014: #                   else
 4015:                     if (sem_wait((*s_etat_processus).semaphore_fork) == -1)
 4016: #                   endif
 4017:                     {
 4018:                         if (errno != EINTR)
 4019:                         {
 4020:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 4021:                             return;
 4022:                         }
 4023:                     }
 4024: 
 4025:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4026:                     return;
 4027:                 }
 4028: 
 4029: #               ifndef SEMAPHORES_NOMMES
 4030:                 if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4031: #               else
 4032:                 if (sem_wait((*s_etat_processus).semaphore_fork) == -1)
 4033: #               endif
 4034:                 {
 4035:                     if (errno != EINTR)
 4036:                     {
 4037:                         (*s_etat_processus).erreur_systeme = d_es_processus;
 4038:                         return;
 4039:                     }
 4040:                 }
 4041:             } while((!WIFEXITED(status)) && (!WIFSIGNALED(status)));
 4042: 
 4043:             longueur_lecture = 256;
 4044:             pointeur = 0;
 4045:             nombre_iterations = 1;
 4046: 
 4047:             if ((tampon = malloc((longueur_lecture + 1) *
 4048:                     sizeof(unsigned char))) == NULL)
 4049:             {
 4050:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4051:                 return;
 4052:             }
 4053: 
 4054: #           ifndef SEMAPHORES_NOMMES
 4055:             if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 4056:             {
 4057:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4058:                 return;
 4059:             }
 4060: #           else
 4061:             if (sem_post((*s_etat_processus).semaphore_fork) != 0)
 4062:             {
 4063:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4064:                 return;
 4065:             }
 4066: #           endif
 4067: 
 4068:             while((ios = read_atomic(s_etat_processus,
 4069:                     pipes_sortie[0], &(tampon[pointeur]),
 4070:                     longueur_lecture)) > 0)
 4071:             {
 4072: #               ifndef SEMAPHORES_NOMMES
 4073:                 while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4074: #               else
 4075:                 while(sem_wait((*s_etat_processus).semaphore_fork) == -1)
 4076: #               endif
 4077:                 {
 4078:                     if (errno != EINTR)
 4079:                     {
 4080:                         (*s_etat_processus).erreur_systeme = d_es_processus;
 4081:                         return;
 4082:                     }
 4083:                 }
 4084: 
 4085:                 tampon[pointeur + ios] = d_code_fin_chaine;
 4086:                 pointeur += longueur_lecture;
 4087:                 nombre_iterations++;
 4088: 
 4089:                 if ((tampon = realloc(tampon,
 4090:                         ((nombre_iterations * longueur_lecture) + 1) *
 4091:                         sizeof(unsigned char))) == NULL)
 4092:                 {
 4093:                     (*s_etat_processus).erreur_systeme =
 4094:                             d_es_allocation_memoire;
 4095:                     return;
 4096:                 }
 4097: 
 4098: #               ifndef SEMAPHORES_NOMMES
 4099:                 if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 4100: #               else
 4101:                 if (sem_post((*s_etat_processus).semaphore_fork) != 0)
 4102: #               endif
 4103:                 {
 4104:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4105:                     return;
 4106:                 }
 4107:             }
 4108: 
 4109: #           ifndef SEMAPHORES_NOMMES
 4110:             while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4111: #           else
 4112:             while(sem_wait((*s_etat_processus).semaphore_fork) == -1)
 4113: #           endif
 4114:             {
 4115:                 if (errno != EINTR)
 4116:                 {
 4117:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4118:                     return;
 4119:                 }
 4120:             }
 4121: 
 4122:             if ((tampon = realloc(tampon, (strlen(tampon) + 1) *
 4123:                     sizeof(unsigned char))) == NULL)
 4124:             {
 4125:                 (*s_etat_processus).erreur_systeme =
 4126:                         d_es_allocation_memoire;
 4127:                 return;
 4128:             }
 4129: 
 4130:             if (ios == -1)
 4131:             {
 4132:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4133:                 return;
 4134:             }
 4135: 
 4136:             if (close(pipes_sortie[0]) != 0)
 4137:             {
 4138:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4139:                 return;
 4140:             }
 4141: 
 4142:             /*
 4143:              * Transformation de la chaîne en liste
 4144:              */
 4145: 
 4146:             longueur_tampon = strlen(tampon);
 4147: 
 4148:             for(i = 0, ptr = tampon, nombre_lignes = 0;
 4149:                     i < (long) longueur_tampon; i++, ptr++)
 4150:             {
 4151:                 if ((*ptr) == d_code_retour_chariot)
 4152:                 {
 4153:                     nombre_lignes++;
 4154:                     (*ptr) = d_code_fin_chaine;
 4155:                 }
 4156:             }
 4157: 
 4158:             if ((s_objet_resultat = allocation(s_etat_processus, LST))
 4159:                     == NULL)
 4160:             {
 4161:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4162:                 return;
 4163:             }
 4164: 
 4165:             if (nombre_lignes == 0)
 4166:             {
 4167:                 (*s_objet_resultat).objet = NULL;
 4168:             }
 4169:             else
 4170:             {
 4171:                 if (((*s_objet_resultat).objet =
 4172:                         allocation_maillon(s_etat_processus)) == NULL)
 4173:                 {
 4174:                     (*s_etat_processus).erreur_systeme =
 4175:                             d_es_allocation_memoire;
 4176:                     return;
 4177:                 }
 4178: 
 4179:                 l_element_precedent = NULL;
 4180:                 l_element_courant = (struct_liste_chainee *)
 4181:                         (*s_objet_resultat).objet;
 4182: 
 4183:                 for(i = 0, ptr = tampon; i < (long) nombre_lignes; i++)
 4184:                 {
 4185:                     if (((*l_element_courant).donnee =
 4186:                             allocation(s_etat_processus, CHN)) == NULL)
 4187:                     {
 4188:                         (*s_etat_processus).erreur_systeme =
 4189:                                 d_es_allocation_memoire;
 4190:                         return;
 4191:                     }
 4192: 
 4193:                     if (((*(*l_element_courant).donnee).objet =
 4194:                             malloc((strlen(ptr) + 1) * sizeof(unsigned char)))
 4195:                             == NULL)
 4196:                     {
 4197:                         (*s_etat_processus).erreur_systeme =
 4198:                                 d_es_allocation_memoire;
 4199:                         return;
 4200:                     }
 4201: 
 4202:                     strcpy((*(*l_element_courant).donnee).objet, ptr);
 4203:                 
 4204:                     while((*ptr) != d_code_fin_chaine)
 4205:                     {
 4206:                         ptr++;
 4207:                     }
 4208: 
 4209:                     ptr++;
 4210: 
 4211:                     if (((*l_element_courant).suivant =
 4212:                             allocation_maillon(s_etat_processus)) == NULL)
 4213:                     {
 4214:                         (*s_etat_processus).erreur_systeme =
 4215:                                 d_es_allocation_memoire;
 4216:                         return;
 4217:                     }
 4218: 
 4219:                     l_element_precedent = l_element_courant;
 4220:                     l_element_courant = (*l_element_courant).suivant;
 4221:                 }
 4222: 
 4223:                 free(l_element_courant);
 4224: 
 4225:                 if (l_element_precedent != NULL)
 4226:                 {
 4227:                     (*l_element_precedent).suivant = NULL;
 4228:                 }
 4229:             }
 4230: 
 4231:             free(tampon);
 4232:         }
 4233: 
 4234:         if (sigaction(SIGINT, &action_passee, NULL) != 0)
 4235:         {
 4236:             for(i = 0; i < nombre_arguments; i++)
 4237:             {
 4238:                 depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4239:                         &s_objet_temporaire);
 4240:                 liberation(s_etat_processus, s_objet_temporaire);
 4241:             }
 4242: 
 4243:             free(arguments);
 4244:             (*s_etat_processus).erreur_systeme = d_es_signal;
 4245:             return;
 4246:         }
 4247: 
 4248:         for(i = 0; i < nombre_arguments; i++)
 4249:         {
 4250:             depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4251:                     &s_objet_temporaire);
 4252:             liberation(s_etat_processus, s_objet_temporaire);
 4253:         }
 4254: 
 4255:         if ((tampon = malloc(sizeof(unsigned char))) == NULL)
 4256:         {
 4257:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4258:             return;
 4259:         }
 4260:  
 4261: #       ifndef SEMAPHORES_NOMMES
 4262:         if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 4263: #       else
 4264:         if (sem_post((*s_etat_processus).semaphore_fork) != 0)
 4265: #       endif
 4266:         {
 4267:             (*s_etat_processus).erreur_systeme = d_es_processus;
 4268:             return;
 4269:         }
 4270: 
 4271:         if (read_atomic(s_etat_processus, pipes_erreur[0], tampon, 1) > 0)
 4272:         {
 4273:             // Le processus fils renvoie une erreur.
 4274: 
 4275:             (*s_etat_processus).erreur_execution = d_ex_erreur_processus;
 4276:             liberation(s_etat_processus, s_objet_resultat);
 4277:         }
 4278:         else if (empilement(s_etat_processus,
 4279:                 &((*s_etat_processus).l_base_pile), s_objet_resultat)
 4280:                 == d_erreur)
 4281:         {
 4282: #           ifndef SEMAPHORES_NOMMES
 4283:             while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4284: #           else
 4285:             while(sem_wait((*s_etat_processus).semaphore_fork) == -1)
 4286: #           endif
 4287:             {
 4288:                 if (errno != EINTR)
 4289:                 {
 4290:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4291:                     return;
 4292:                 }
 4293:             }
 4294: 
 4295:             if (close(pipes_erreur[0]) != 0)
 4296:             {
 4297:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4298:                 return;
 4299:             }
 4300: 
 4301:             free(tampon);
 4302:             return;
 4303:         }
 4304: 
 4305: #       ifndef SEMAPHORES_NOMMES
 4306:         while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4307: #       else
 4308:         while(sem_wait((*s_etat_processus).semaphore_fork) == -1)
 4309: #       endif
 4310:         {
 4311:             if (errno != EINTR)
 4312:             {
 4313:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4314:                 return;
 4315:             }
 4316:         }
 4317: 
 4318:         if (close(pipes_erreur[0]) != 0)
 4319:         {
 4320:             (*s_etat_processus).erreur_systeme = d_es_processus;
 4321:             return;
 4322:         }
 4323: 
 4324:         free(arguments);
 4325:         free(tampon);
 4326:     }
 4327:     else
 4328:     {
 4329:         if (presence_stdin == d_vrai)
 4330:         {
 4331:             s_objet = s_objet_composite;
 4332:         }
 4333: 
 4334:         liberation(s_etat_processus, s_objet);
 4335: 
 4336:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 4337:         return;
 4338:     }
 4339: 
 4340:     if (presence_stdin == d_vrai)
 4341:     {
 4342:         s_objet = s_objet_composite;
 4343:     }
 4344: 
 4345:     liberation(s_etat_processus, s_objet);
 4346: 
 4347:     return;
 4348: }
 4349: 
 4350: 
 4351: /*
 4352: ================================================================================
 4353:   Fonction 'sign'
 4354: ================================================================================
 4355:   Entrées :
 4356: --------------------------------------------------------------------------------
 4357:   Sorties :
 4358: --------------------------------------------------------------------------------
 4359:   Effets de bord : néant
 4360: ================================================================================
 4361: */
 4362: 
 4363: void
 4364: instruction_sign(struct_processus *s_etat_processus)
 4365: {
 4366:     real8                               norme;
 4367: 
 4368:     struct_liste_chainee                *l_element_courant;
 4369:     struct_liste_chainee                *l_element_precedent;
 4370: 
 4371:     struct_objet                        *s_copie_argument;
 4372:     struct_objet                        *s_objet_argument;
 4373:     struct_objet                        *s_objet_resultat;
 4374: 
 4375:     (*s_etat_processus).erreur_execution = d_ex;
 4376: 
 4377:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4378:     {
 4379:         printf("\n  SIGN ");
 4380: 
 4381:         if ((*s_etat_processus).langue == 'F')
 4382:         {
 4383:             printf("(signe)\n\n");
 4384:         }
 4385:         else
 4386:         {
 4387:             printf("(sign)\n\n");
 4388:         }
 4389: 
 4390:         printf("    1: %s, %s\n", d_INT, d_REL);
 4391:         printf("->  1: %s\n\n", d_INT);
 4392: 
 4393:         printf("    1: %s\n", d_CPL);
 4394:         printf("->  1: %s\n\n", d_CPL);
 4395: 
 4396:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 4397:         printf("->  1: %s\n\n", d_ALG);
 4398: 
 4399:         printf("    1: %s\n", d_RPN);
 4400:         printf("->  1: %s\n", d_RPN);
 4401: 
 4402:         return;
 4403:     }
 4404:     else if ((*s_etat_processus).test_instruction == 'Y')
 4405:     {
 4406:         (*s_etat_processus).nombre_arguments = 1;
 4407:         return;
 4408:     }
 4409:     
 4410:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 4411:     {
 4412:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 4413:         {
 4414:             return;
 4415:         }
 4416:     }
 4417: 
 4418:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4419:             &s_objet_argument) == d_erreur)
 4420:     {
 4421:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 4422:         return;
 4423:     }
 4424: 
 4425: /*
 4426: --------------------------------------------------------------------------------
 4427:   Signe d'un entier
 4428: --------------------------------------------------------------------------------
 4429: */
 4430: 
 4431:     if ((*s_objet_argument).type == INT)
 4432:     {
 4433:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 4434:         {
 4435:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4436:             return;
 4437:         }
 4438: 
 4439:         if ((*((integer8 *) (*s_objet_argument).objet)) > 0)
 4440:         {
 4441:             (*((integer8 *) (*s_objet_resultat).objet)) = 1;
 4442:         }
 4443:         else if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
 4444:         {
 4445:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 4446:         }
 4447:         else
 4448:         {
 4449:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 4450:         }
 4451:     }
 4452: 
 4453: /*
 4454: --------------------------------------------------------------------------------
 4455:   Signe d'un réel
 4456: --------------------------------------------------------------------------------
 4457: */
 4458: 
 4459:     else if ((*s_objet_argument).type == REL)
 4460:     {
 4461:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 4462:         {
 4463:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4464:             return;
 4465:         }
 4466: 
 4467:         if ((*((real8 *) (*s_objet_argument).objet)) > 0)
 4468:         {
 4469:             (*((integer8 *) (*s_objet_resultat).objet)) = 1;
 4470:         }
 4471:         else if ((*((real8 *) (*s_objet_argument).objet)) < 0)
 4472:         {
 4473:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 4474:         }
 4475:         else
 4476:         {
 4477:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 4478:         }
 4479:     }
 4480: 
 4481: /*
 4482: --------------------------------------------------------------------------------
 4483:   Vecteur unité dans la direction du complexe
 4484: --------------------------------------------------------------------------------
 4485: */
 4486: 
 4487:     else if ((*s_objet_argument).type == CPL)
 4488:     {
 4489:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
 4490:         {
 4491:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4492:             return;
 4493:         }
 4494: 
 4495:         if (((*((struct_complexe16 *) (*s_objet_argument).objet)).partie_reelle
 4496:                 != 0) || ((*((struct_complexe16 *) (*s_objet_argument).objet))
 4497:                 .partie_imaginaire != 0))
 4498:         {
 4499:             f77absc_((struct_complexe16 *) (*s_objet_argument).objet, &norme);
 4500:             f77divisioncr_((struct_complexe16 *) (*s_objet_argument).objet,
 4501:                     &norme, (struct_complexe16 *) (*s_objet_resultat).objet);
 4502:         }
 4503:         else
 4504:         {
 4505:             (*((struct_complexe16 *) (*s_objet_argument).objet))
 4506:                     .partie_reelle = 0;
 4507:             (*((struct_complexe16 *) (*s_objet_argument).objet))
 4508:                     .partie_imaginaire = 0;
 4509:         }
 4510:     }
 4511: 
 4512: /*
 4513: --------------------------------------------------------------------------------
 4514:   Signe d'un nom
 4515: --------------------------------------------------------------------------------
 4516: */
 4517: 
 4518:     else if ((*s_objet_argument).type == NOM)
 4519:     {
 4520:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 4521:         {
 4522:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4523:             return;
 4524:         }
 4525: 
 4526:         if (((*s_objet_resultat).objet =
 4527:                 allocation_maillon(s_etat_processus)) == NULL)
 4528:         {
 4529:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4530:             return;
 4531:         }
 4532: 
 4533:         l_element_courant = (*s_objet_resultat).objet;
 4534: 
 4535:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 4536:                 == NULL)
 4537:         {
 4538:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4539:             return;
 4540:         }
 4541: 
 4542:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4543:                 .nombre_arguments = 0;
 4544:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4545:                 .fonction = instruction_vers_niveau_superieur;
 4546: 
 4547:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4548:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 4549:         {
 4550:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4551:             return;
 4552:         }
 4553: 
 4554:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4555:                 .nom_fonction, "<<");
 4556: 
 4557:         if (((*l_element_courant).suivant =
 4558:                 allocation_maillon(s_etat_processus)) == NULL)
 4559:         {
 4560:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4561:             return;
 4562:         }
 4563: 
 4564:         l_element_courant = (*l_element_courant).suivant;
 4565:         (*l_element_courant).donnee = s_objet_argument;
 4566: 
 4567:         if (((*l_element_courant).suivant =
 4568:                 allocation_maillon(s_etat_processus)) == NULL)
 4569:         {
 4570:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4571:             return;
 4572:         }
 4573: 
 4574:         l_element_courant = (*l_element_courant).suivant;
 4575: 
 4576:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 4577:                 == NULL)
 4578:         {
 4579:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4580:             return;
 4581:         }
 4582: 
 4583:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4584:                 .nombre_arguments = 1;
 4585:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4586:                 .fonction = instruction_sign;
 4587: 
 4588:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4589:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 4590:         {
 4591:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4592:             return;
 4593:         }
 4594: 
 4595:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4596:                 .nom_fonction, "SIGN");
 4597: 
 4598:         if (((*l_element_courant).suivant =
 4599:                 allocation_maillon(s_etat_processus)) == NULL)
 4600:         {
 4601:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4602:             return;
 4603:         }
 4604: 
 4605:         l_element_courant = (*l_element_courant).suivant;
 4606: 
 4607:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 4608:                 == NULL)
 4609:         {
 4610:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4611:             return;
 4612:         }
 4613: 
 4614:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4615:                 .nombre_arguments = 0;
 4616:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4617:                 .fonction = instruction_vers_niveau_inferieur;
 4618: 
 4619:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4620:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 4621:         {
 4622:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4623:             return;
 4624:         }
 4625: 
 4626:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4627:                 .nom_fonction, ">>");
 4628: 
 4629:         (*l_element_courant).suivant = NULL;
 4630:         s_objet_argument = NULL;
 4631:     }
 4632: 
 4633: /*
 4634: --------------------------------------------------------------------------------
 4635:   Signe d'une expression
 4636: --------------------------------------------------------------------------------
 4637: */
 4638: 
 4639:     else if (((*s_objet_argument).type == ALG) ||
 4640:             ((*s_objet_argument).type == RPN))
 4641:     {
 4642:         if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
 4643:                 'N')) == NULL)
 4644:         {
 4645:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4646:             return;
 4647:         }
 4648: 
 4649:         l_element_courant = (struct_liste_chainee *)
 4650:                 (*s_copie_argument).objet;
 4651:         l_element_precedent = l_element_courant;
 4652: 
 4653:         while((*l_element_courant).suivant != NULL)
 4654:         {
 4655:             l_element_precedent = l_element_courant;
 4656:             l_element_courant = (*l_element_courant).suivant;
 4657:         }
 4658: 
 4659:         if (((*l_element_precedent).suivant =
 4660:                 allocation_maillon(s_etat_processus)) == NULL)
 4661:         {
 4662:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4663:             return;
 4664:         }
 4665: 
 4666:         if (((*(*l_element_precedent).suivant).donnee =
 4667:                 allocation(s_etat_processus, FCT)) == NULL)
 4668:         {
 4669:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4670:             return;
 4671:         }
 4672: 
 4673:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 4674:                 .donnee).objet)).nombre_arguments = 1;
 4675:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 4676:                 .donnee).objet)).fonction = instruction_sign;
 4677: 
 4678:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 4679:                 .suivant).donnee).objet)).nom_fonction =
 4680:                 malloc(5 * sizeof(unsigned char))) == NULL)
 4681:         {
 4682:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4683:             return;
 4684:         }
 4685: 
 4686:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 4687:                 .suivant).donnee).objet)).nom_fonction, "SIGN");
 4688: 
 4689:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 4690: 
 4691:         s_objet_resultat = s_copie_argument;
 4692:     }
 4693: 
 4694: /*
 4695: --------------------------------------------------------------------------------
 4696:   Fonction signe impossible à réaliser
 4697: --------------------------------------------------------------------------------
 4698: */
 4699: 
 4700:     else
 4701:     {
 4702:         liberation(s_etat_processus, s_objet_argument);
 4703: 
 4704:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 4705:         return;
 4706:     }
 4707: 
 4708:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4709:             s_objet_resultat) == d_erreur)
 4710:     {
 4711:         return;
 4712:     }
 4713: 
 4714:     liberation(s_etat_processus, s_objet_argument);
 4715: 
 4716:     return;
 4717: }
 4718: 
 4719: 
 4720: /*
 4721: ================================================================================
 4722:   Fonction 'select'
 4723: ================================================================================
 4724:   Entrées : pointeur sur une struct_processus
 4725: --------------------------------------------------------------------------------
 4726:   Sorties :
 4727: --------------------------------------------------------------------------------
 4728:   Effets de bord : néant
 4729: ================================================================================
 4730: */
 4731: 
 4732: void
 4733: instruction_select(struct_processus *s_etat_processus)
 4734: {
 4735:     (*s_etat_processus).erreur_execution = d_ex;
 4736: 
 4737:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4738:     {
 4739:         printf("\n  SELECT ");
 4740: 
 4741:         if ((*s_etat_processus).langue == 'F')
 4742:         {
 4743:             printf("(structure de contrôle)\n\n");
 4744:             printf("  Utilisation :\n\n");
 4745:         }
 4746:         else
 4747:         {
 4748:             printf("(control statement)\n\n");
 4749:             printf("  Usage:\n\n");
 4750:         }
 4751: 
 4752:         printf("    SELECT (expression test)\n");
 4753:         printf("        CASE (clause 1) THEN (expression 1) END\n");
 4754:         printf("        CASE (clause 2) THEN (expression 2) END\n");
 4755:         printf("        ...\n");
 4756:         printf("        CASE (clause n) THEN (expression n) END\n");
 4757:         printf("    DEFAULT\n");
 4758:         printf("        (expression)\n");
 4759:         printf("    END\n\n");
 4760: 
 4761:         printf("    SELECT (expression test)\n");
 4762:         printf("        CASE (clause 1) THEN (expression 1) END\n");
 4763:         printf("        (expression)\n");
 4764:         printf("        CASE (clause 2) THEN (expression 2) END\n");
 4765:         printf("    END\n");
 4766: 
 4767:         return;
 4768:     }
 4769:     else if ((*s_etat_processus).test_instruction == 'Y')
 4770:     {
 4771:         (*s_etat_processus).nombre_arguments = -1;
 4772:         return;
 4773:     }
 4774: 
 4775:     empilement_pile_systeme(s_etat_processus);
 4776: 
 4777:     if ((*s_etat_processus).erreur_systeme != d_es)
 4778:     {
 4779:         return;
 4780:     }
 4781: 
 4782:     (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'C';
 4783:     (*(*s_etat_processus).l_base_pile_systeme).clause = 'S';
 4784: 
 4785:     return;
 4786: }
 4787: 
 4788: 
 4789: /*
 4790: ================================================================================
 4791:   Fonction 'std'
 4792: ================================================================================
 4793:   Entrées : pointeur sur une struct_processus
 4794: --------------------------------------------------------------------------------
 4795:   Sorties :
 4796: --------------------------------------------------------------------------------
 4797:   Effets de bord : néant
 4798: ================================================================================
 4799: */
 4800: 
 4801: void
 4802: instruction_std(struct_processus *s_etat_processus)
 4803: {
 4804:     (*s_etat_processus).erreur_execution = d_ex;
 4805: 
 4806:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4807:     {
 4808:         printf("\n  STD ");
 4809: 
 4810:         if ((*s_etat_processus).langue == 'F')
 4811:         {
 4812:             printf("(format standard)\n\n");
 4813:             printf("  Aucun argument\n");
 4814:         }
 4815:         else
 4816:         {
 4817:             printf("(standard format)\n\n");
 4818:             printf("  No argument\n");
 4819:         }
 4820: 
 4821:         return;
 4822:     }
 4823:     else if ((*s_etat_processus).test_instruction == 'Y')
 4824:     {
 4825:         (*s_etat_processus).nombre_arguments = -1;
 4826:         return;
 4827:     }
 4828: 
 4829:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 4830:     {
 4831:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 4832:         {
 4833:             return;
 4834:         }
 4835:     }
 4836: 
 4837:     cf(s_etat_processus, 49);
 4838:     cf(s_etat_processus, 50);
 4839: 
 4840:     return;
 4841: }
 4842: 
 4843: 
 4844: /*
 4845: ================================================================================
 4846:   Fonction 'sci'
 4847: ================================================================================
 4848:   Entrées : pointeur sur une struct_processus
 4849: --------------------------------------------------------------------------------
 4850:   Sorties :
 4851: --------------------------------------------------------------------------------
 4852:   Effets de bord : néant
 4853: ================================================================================
 4854: */
 4855: 
 4856: void
 4857: instruction_sci(struct_processus *s_etat_processus)
 4858: {
 4859:     struct_objet                        *s_objet_argument;
 4860:     struct_objet                        *s_objet;
 4861: 
 4862:     logical1                            i43;
 4863:     logical1                            i44;
 4864: 
 4865:     unsigned char                       *valeur_binaire;
 4866: 
 4867:     unsigned long                       i;
 4868:     unsigned long                       j;
 4869: 
 4870:     (*s_etat_processus).erreur_execution = d_ex;
 4871: 
 4872:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4873:     {
 4874:         printf("\n  SCI ");
 4875: 
 4876:         if ((*s_etat_processus).langue == 'F')
 4877:         {
 4878:             printf("(format scientifique)\n\n");
 4879:         }
 4880:         else
 4881:         {
 4882:             printf("(scientific format)\n\n");
 4883:         }
 4884: 
 4885:         printf("    1: %s\n", d_INT);
 4886: 
 4887:         return;
 4888:     }
 4889:     else if ((*s_etat_processus).test_instruction == 'Y')
 4890:     {
 4891:         (*s_etat_processus).nombre_arguments = -1;
 4892:         return;
 4893:     }
 4894: 
 4895:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 4896:     {
 4897:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 4898:         {
 4899:             return;
 4900:         }
 4901:     }
 4902: 
 4903:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4904:             &s_objet_argument) == d_erreur)
 4905:     {
 4906:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 4907:         return;
 4908:     }
 4909: 
 4910:     if ((*s_objet_argument).type == INT)
 4911:     {
 4912:         if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
 4913:                 ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
 4914:         {
 4915:             if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
 4916:             {
 4917:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4918:                 return;
 4919:             }
 4920: 
 4921:             (*((logical8 *) (*s_objet).objet)) =
 4922:                     (*((integer8 *) (*s_objet_argument).objet));
 4923: 
 4924:             i43 = test_cfsf(s_etat_processus, 43);
 4925:             i44 = test_cfsf(s_etat_processus, 44);
 4926: 
 4927:             sf(s_etat_processus, 44);
 4928:             cf(s_etat_processus, 43);
 4929: 
 4930:             if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
 4931:                     == NULL)
 4932:             {
 4933:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4934:                 return;
 4935:             }
 4936: 
 4937:             if (i43 == d_vrai)
 4938:             {
 4939:                 sf(s_etat_processus, 43);
 4940:             }
 4941:             else
 4942:             {
 4943:                 cf(s_etat_processus, 43);
 4944:             }
 4945: 
 4946:             if (i44 == d_vrai)
 4947:             {
 4948:                 sf(s_etat_processus, 44);
 4949:             }
 4950:             else
 4951:             {
 4952:                 cf(s_etat_processus, 44);
 4953:             }
 4954: 
 4955:             for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
 4956:             {
 4957:                 if (valeur_binaire[i] == '0')
 4958:                 {
 4959:                     cf(s_etat_processus, j++);
 4960:                 }
 4961:                 else
 4962:                 {
 4963:                     sf(s_etat_processus, j++);
 4964:                 }
 4965:             }
 4966: 
 4967:             for(; j <= 56; cf(s_etat_processus, j++));
 4968: 
 4969:             cf(s_etat_processus, 49);
 4970:             sf(s_etat_processus, 50);
 4971: 
 4972:             free(valeur_binaire);
 4973:             liberation(s_etat_processus, s_objet);
 4974:         }
 4975:         else
 4976:         {
 4977:             liberation(s_etat_processus, s_objet_argument);
 4978: 
 4979:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 4980:             return;
 4981:         }
 4982:     }
 4983:     else
 4984:     {
 4985:         liberation(s_etat_processus, s_objet_argument);
 4986: 
 4987:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 4988:         return;
 4989:     }
 4990: 
 4991:     liberation(s_etat_processus, s_objet_argument);
 4992: 
 4993:     return;
 4994: }
 4995: 
 4996: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>