File:  [local] / rpl / src / instructions_s1.c
Revision 1.7: download - view: text, annotated - select for diffs - revision graph
Wed Apr 7 13:45:08 2010 UTC (14 years ago) by bertrand
Branches: MAIN
CVS tags: HEAD
En route pour la 4.0.14 !

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.14
    4:   Copyright (C) 1989-2010 Dr. BERTRAND Joël
    5: 
    6:   This file is part of RPL/2.
    7: 
    8:   RPL/2 is free software; you can redistribute it and/or modify it
    9:   under the terms of the CeCILL V2 License as published by the french
   10:   CEA, CNRS and INRIA.
   11:  
   12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
   13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
   15:   for more details.
   16:  
   17:   You should have received a copy of the CeCILL License
   18:   along with RPL/2. If not, write to info@cecill.info.
   19: ================================================================================
   20: */
   21: 
   22: 
   23: #include "rpl.conv.h"
   24: 
   25: 
   26: /*
   27: ================================================================================
   28:   Fonction '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:         return;
 1279:     }
 1280:     else if ((*s_etat_processus).test_instruction == 'Y')
 1281:     {
 1282:         (*s_etat_processus).nombre_arguments = -1;
 1283:         return;
 1284:     }
 1285:     
 1286:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 1287:     {
 1288:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 1289:         {
 1290:         return;
 1291:     }
 1292:     }
 1293: 
 1294:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1295:             &s_objet_argument_1) == d_erreur)
 1296:     {
 1297:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1298:         return;
 1299:     }
 1300: 
 1301:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1302:             &s_objet_argument_2) == d_erreur)
 1303:     {
 1304:         liberation(s_etat_processus, s_objet_argument_1);
 1305: 
 1306:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1307:         return;
 1308:     }
 1309: 
 1310: /*
 1311: --------------------------------------------------------------------------------
 1312:   SAME sur des valeurs numériques
 1313: --------------------------------------------------------------------------------
 1314: */
 1315: 
 1316:     if ((((*s_objet_argument_1).type == INT) ||
 1317:             ((*s_objet_argument_1).type == REL)) &&
 1318:             (((*s_objet_argument_2).type == INT) ||
 1319:             ((*s_objet_argument_2).type == REL)))
 1320:     {
 1321:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1322:         {
 1323:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1324:             return;
 1325:         }
 1326: 
 1327:         if ((*s_objet_argument_1).type == INT)
 1328:         {
 1329:             if ((*s_objet_argument_2).type == INT)
 1330:             {
 1331:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1332:                         ((*((integer8 *) (*s_objet_argument_1).objet)) ==
 1333:                         (*((integer8 *) (*s_objet_argument_2).objet)))
 1334:                         ? -1 : 0;
 1335:             }
 1336:             else
 1337:             {
 1338:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1339:                         ((*((integer8 *) (*s_objet_argument_1).objet)) ==
 1340:                         (*((real8 *) (*s_objet_argument_2).objet)))
 1341:                         ? -1 : 0;
 1342:             }
 1343:         }
 1344:         else
 1345:         {
 1346:             if ((*s_objet_argument_2).type == INT)
 1347:             {
 1348:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1349:                         ((*((real8 *) (*s_objet_argument_1).objet)) ==
 1350:                         (*((integer8 *) (*s_objet_argument_2).objet)))
 1351:                         ? -1 : 0;
 1352:             }
 1353:             else
 1354:             {
 1355:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1356:                         ((*((real8 *) (*s_objet_argument_1).objet)) ==
 1357:                         (*((real8 *) (*s_objet_argument_2).objet)))
 1358:                         ? -1 : 0;
 1359:             }
 1360:         }
 1361:     }
 1362: 
 1363: /*
 1364: --------------------------------------------------------------------------------
 1365:   SAME Processus
 1366: --------------------------------------------------------------------------------
 1367: */
 1368: 
 1369:     else if (((*s_objet_argument_1).type == PRC) &&
 1370:             ((*s_objet_argument_2).type == PRC))
 1371:     {
 1372:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1373:         {
 1374:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1375:             return;
 1376:         }
 1377: 
 1378:         if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet)).thread)
 1379:                 .processus_detache != (*(*((struct_processus_fils *)
 1380:                 (*s_objet_argument_2).objet)).thread).processus_detache)
 1381:         {
 1382:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1383:         }
 1384:         else
 1385:         {
 1386:             if ((*(*((struct_processus_fils *) (*s_objet_argument_1).objet))
 1387:                     .thread).processus_detache == d_vrai)
 1388:             {
 1389:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1390:                         ((*(*((struct_processus_fils *) (*s_objet_argument_1)
 1391:                         .objet)).thread).pid ==
 1392:                         (*(*((struct_processus_fils *) (*s_objet_argument_2)
 1393:                         .objet)).thread).pid) ? -1 : 0;
 1394:             }
 1395:             else
 1396:             {
 1397:                 (*((integer8 *) (*s_objet_resultat).objet)) =
 1398:                         ((pthread_equal((*(*((struct_processus_fils *)
 1399:                         (*s_objet_argument_1).objet)).thread).tid,
 1400:                         (*(*((struct_processus_fils *) (*s_objet_argument_2)
 1401:                         .objet)).thread).tid) != 0) &&
 1402:                         ((*(*((struct_processus_fils *)
 1403:                         (*s_objet_argument_1).objet)).thread).pid ==
 1404:                         (*(*((struct_processus_fils *) (*s_objet_argument_2)
 1405:                         .objet)).thread).pid)) ? -1 : 0;
 1406:             }
 1407:         }
 1408:     }
 1409: 
 1410: /*
 1411: --------------------------------------------------------------------------------
 1412:   SAME complexe
 1413: --------------------------------------------------------------------------------
 1414: */
 1415: 
 1416:     else if (((*s_objet_argument_1).type == CPL) &&
 1417:             ((*s_objet_argument_2).type == CPL))
 1418:     {
 1419:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1420:         {
 1421:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1422:             return;
 1423:         }
 1424: 
 1425:         (*((integer8 *) (*s_objet_resultat).objet)) =
 1426:                 (((*((struct_complexe16 *) (*s_objet_argument_1).objet))
 1427:                 .partie_reelle == (*((struct_complexe16 *) (*s_objet_argument_2)
 1428:                 .objet)).partie_reelle) && ((*((struct_complexe16 *)
 1429:                 (*s_objet_argument_1).objet)).partie_imaginaire ==
 1430:                 ((*((struct_complexe16 *) (*s_objet_argument_1).objet))
 1431:                 .partie_imaginaire))) ? -1 : 0;
 1432:     }
 1433: 
 1434: /*
 1435: --------------------------------------------------------------------------------
 1436:   SAME binaire
 1437: --------------------------------------------------------------------------------
 1438: */
 1439: 
 1440:     else if (((*s_objet_argument_1).type == BIN) &&
 1441:             ((*s_objet_argument_2).type == BIN))
 1442:     {
 1443:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1444:         {
 1445:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1446:             return;
 1447:         }
 1448: 
 1449:         (*((integer8 *) (*s_objet_resultat).objet)) = 
 1450:                 ((*((logical8 *) (*s_objet_argument_1).objet)) ==
 1451:                 (*((logical8 *) (*s_objet_argument_2).objet)))
 1452:                 ? -1 : 0;
 1453:     }
 1454: 
 1455: /*
 1456: --------------------------------------------------------------------------------
 1457:   SAME portant sur des chaînes de caractères
 1458: --------------------------------------------------------------------------------
 1459: */
 1460: 
 1461:     else if (((*s_objet_argument_1).type == CHN) &&
 1462:             ((*s_objet_argument_2).type == CHN))
 1463:     {
 1464:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1465:         {
 1466:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1467:             return;
 1468:         }
 1469: 
 1470:         (*((integer8 *) (*s_objet_resultat).objet)) =
 1471:                 (strcmp((unsigned char *) (*s_objet_argument_1).objet,
 1472:                 (unsigned char *) (*s_objet_argument_2).objet) == 0) ? -1 : 0;
 1473:     }
 1474: 
 1475: /*
 1476: --------------------------------------------------------------------------------
 1477:   SAME portant sur des listes ou (instruction "SAME") des expressions
 1478: --------------------------------------------------------------------------------
 1479: */
 1480: 
 1481:     else if (((*s_objet_argument_1).type == FCT) &&
 1482:             ((*s_objet_argument_2).type == FCT))
 1483:     {
 1484:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1485:         {
 1486:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1487:             return;
 1488:         }
 1489: 
 1490:         if ((strcmp((*((struct_fonction *) (*s_objet_argument_1).objet))
 1491:                 .nom_fonction, (*((struct_fonction *) (*s_objet_argument_2)
 1492:                 .objet)).nom_fonction) == 0) &&
 1493:                 ((*((struct_fonction *) (*s_objet_argument_1).objet))
 1494:                 .nombre_arguments == (*((struct_fonction *)
 1495:                 (*s_objet_argument_2).objet)).nombre_arguments))
 1496:         {
 1497:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 1498:         }
 1499:         else
 1500:         {
 1501:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1502:         }
 1503:     }
 1504: 
 1505:     /*
 1506:      * Il y a de la récursivité dans l'air...
 1507:      */
 1508: 
 1509:     else if ((((*s_objet_argument_1).type == LST) &&
 1510:             ((*s_objet_argument_2).type == LST)) ||
 1511:             (((((*s_objet_argument_1).type == ALG) &&
 1512:             ((*s_objet_argument_2).type == ALG)) ||
 1513:             (((*s_objet_argument_1).type == RPN) &&
 1514:             ((*s_objet_argument_2).type == RPN))) &&
 1515:             (strcmp((*s_etat_processus).instruction_courante, "==") != 0)))
 1516:     {
 1517:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1518:         {
 1519:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1520:             return;
 1521:         }
 1522: 
 1523:         l_element_courant_1 = (struct_liste_chainee *)
 1524:                 (*s_objet_argument_1).objet;
 1525:         l_element_courant_2 = (struct_liste_chainee *)
 1526:                 (*s_objet_argument_2).objet;
 1527: 
 1528:         difference = d_faux;
 1529: 
 1530:         while((l_element_courant_1 != NULL) && (l_element_courant_2 != NULL)
 1531:                 && (difference == d_faux))
 1532:         {
 1533:             if ((s_copie_argument_1 = copie_objet(s_etat_processus,
 1534:                     (*l_element_courant_1).donnee, 'P')) == NULL)
 1535:             {
 1536:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1537:                 return;
 1538:             }
 1539: 
 1540:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1541:                     s_copie_argument_1) == d_erreur)
 1542:             {
 1543:                 return;
 1544:             }
 1545: 
 1546:             if ((s_copie_argument_2 = copie_objet(s_etat_processus,
 1547:                     (*l_element_courant_2).donnee, 'P')) == NULL)
 1548:             {
 1549:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1550:                 return;
 1551:             }
 1552: 
 1553:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1554:                     s_copie_argument_2) == d_erreur)
 1555:             {
 1556:                 return;
 1557:             }
 1558: 
 1559:             instruction_same(s_etat_processus);
 1560: 
 1561:             if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 1562:                     &s_objet_resultat_intermediaire) == d_erreur)
 1563:             {
 1564:                 liberation(s_etat_processus, s_objet_argument_1);
 1565:                 liberation(s_etat_processus, s_objet_argument_2);
 1566:                 liberation(s_etat_processus, s_objet_resultat);
 1567: 
 1568:                 (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1569:                 return;
 1570:             }
 1571: 
 1572:             if ((*s_objet_resultat_intermediaire).type != INT)
 1573:             {
 1574:                 liberation(s_etat_processus, s_objet_argument_1);
 1575:                 liberation(s_etat_processus, s_objet_argument_2);
 1576:                 liberation(s_etat_processus, s_objet_resultat);
 1577: 
 1578:                 (*s_etat_processus).erreur_execution =
 1579:                         d_ex_erreur_type_argument;
 1580: 
 1581:                 return;
 1582:             }
 1583: 
 1584:             difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
 1585:                     .objet)) == 0) ? d_vrai : d_faux;
 1586: 
 1587:             liberation(s_etat_processus, s_objet_resultat_intermediaire);
 1588: 
 1589:             l_element_courant_1 = (*l_element_courant_1).suivant;
 1590:             l_element_courant_2 = (*l_element_courant_2).suivant;
 1591:         }
 1592: 
 1593:         if ((difference == d_vrai) || ((l_element_courant_1 != NULL) &&
 1594:                 (l_element_courant_2 == NULL)) ||
 1595:                 ((l_element_courant_1 == NULL) &&
 1596:                 (l_element_courant_2 != NULL)))
 1597:         {
 1598:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1599:         }
 1600:         else
 1601:         {
 1602:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 1603:         }
 1604:     }
 1605: 
 1606: /*
 1607: --------------------------------------------------------------------------------
 1608:   SAME portant sur des tables des expressions
 1609: --------------------------------------------------------------------------------
 1610: */
 1611:     /*
 1612:      * Il y a de la récursivité dans l'air...
 1613:      */
 1614: 
 1615:     else if (((*s_objet_argument_1).type == TBL) &&
 1616:             ((*s_objet_argument_2).type == TBL) &&
 1617:             (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
 1618:     {
 1619:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1620:         {
 1621:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1622:             return;
 1623:         }
 1624: 
 1625:         if ((*((struct_tableau *) (*s_objet_argument_1).objet)).nombre_elements
 1626:                 != (*((struct_tableau *) (*s_objet_argument_2).objet))
 1627:                 .nombre_elements)
 1628:         {
 1629:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1630:         }
 1631:         else
 1632:         {
 1633:             difference = d_faux;
 1634: 
 1635:             for(i = 0; i < (*((struct_tableau *) (*s_objet_argument_1).objet))
 1636:                     .nombre_elements; i++)
 1637:             {
 1638:                 if ((s_copie_argument_1 = copie_objet(s_etat_processus,
 1639:                         (*((struct_tableau *)
 1640:                         (*s_objet_argument_1).objet)).elements[i],
 1641:                         'P')) == NULL)
 1642:                 {
 1643:                     (*s_etat_processus).erreur_systeme =
 1644:                             d_es_allocation_memoire;
 1645:                     return;
 1646:                 }
 1647: 
 1648:                 if (empilement(s_etat_processus, &((*s_etat_processus)
 1649:                         .l_base_pile), s_copie_argument_1) == d_erreur)
 1650:                 {
 1651:                     return;
 1652:                 }
 1653: 
 1654:                 if ((s_copie_argument_2 = copie_objet(s_etat_processus,
 1655:                         (*((struct_tableau *)
 1656:                         (*s_objet_argument_2).objet)).elements[i],
 1657:                         'P')) == NULL)
 1658:                 {
 1659:                     (*s_etat_processus).erreur_systeme =
 1660:                             d_es_allocation_memoire;
 1661:                     return;
 1662:                 }
 1663: 
 1664:                 if (empilement(s_etat_processus, &((*s_etat_processus)
 1665:                         .l_base_pile), s_copie_argument_2) == d_erreur)
 1666:                 {
 1667:                     return;
 1668:                 }
 1669: 
 1670:                 instruction_same(s_etat_processus);
 1671: 
 1672:                 if (depilement(s_etat_processus, &((*s_etat_processus)
 1673:                         .l_base_pile), &s_objet_resultat_intermediaire)
 1674:                         == d_erreur)
 1675:                 {
 1676:                     liberation(s_etat_processus, s_objet_argument_1);
 1677:                     liberation(s_etat_processus, s_objet_argument_2);
 1678:                     liberation(s_etat_processus, s_objet_resultat);
 1679: 
 1680:                     (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 1681:                     return;
 1682:                 }
 1683: 
 1684:                 if ((*s_objet_resultat_intermediaire).type != INT)
 1685:                 {
 1686:                     liberation(s_etat_processus, s_objet_argument_1);
 1687:                     liberation(s_etat_processus, s_objet_argument_2);
 1688:                     liberation(s_etat_processus, s_objet_resultat);
 1689: 
 1690:                     (*s_etat_processus).erreur_execution =
 1691:                             d_ex_erreur_type_argument;
 1692:                     return;
 1693:                 }
 1694: 
 1695:                 difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
 1696:                         .objet)) == 0) ? d_vrai : d_faux;
 1697: 
 1698:                 liberation(s_etat_processus, s_objet_resultat_intermediaire);
 1699:             }
 1700: 
 1701:             if (difference == d_vrai)
 1702:             {
 1703:                 (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1704:             }
 1705:             else
 1706:             {
 1707:                 (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 1708:             }
 1709:         }
 1710:     }
 1711: 
 1712: 
 1713: /*
 1714: --------------------------------------------------------------------------------
 1715:   SAME portant sur des vecteurs
 1716: --------------------------------------------------------------------------------
 1717: */
 1718:     /*
 1719:      * Vecteurs d'entiers
 1720:      */
 1721: 
 1722:     else if (((*s_objet_argument_1).type == VIN) &&
 1723:             ((*s_objet_argument_2).type == VIN))
 1724:     {
 1725:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1726:         {
 1727:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1728:             return;
 1729:         }
 1730: 
 1731:         if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
 1732:                 (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
 1733:         {
 1734:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1735:         }
 1736:         else
 1737:         {
 1738:             difference = d_faux;
 1739: 
 1740:             for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
 1741:                     .taille) && (difference == d_faux); i++)
 1742:             {
 1743:                 difference = (((integer8 *) (*((struct_vecteur *)
 1744:                         (*s_objet_argument_1).objet)).tableau)[i] ==
 1745:                         ((integer8 *) (*((struct_vecteur *)
 1746:                         (*s_objet_argument_2).objet)).tableau)[i])
 1747:                         ? d_faux : d_vrai;
 1748:             }
 1749: 
 1750:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1751:                         d_faux) ? -1 : 0;
 1752:         }
 1753:     }
 1754: 
 1755:     /*
 1756:      * Vecteurs de réels
 1757:      */
 1758: 
 1759:     else if (((*s_objet_argument_1).type == VRL) &&
 1760:             ((*s_objet_argument_2).type == VRL))
 1761:     {
 1762:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1763:         {
 1764:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1765:             return;
 1766:         }
 1767: 
 1768:         if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
 1769:                 (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
 1770:         {
 1771:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1772:         }
 1773:         else
 1774:         {
 1775:             difference = d_faux;
 1776: 
 1777:             for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
 1778:                     .taille) && (difference == d_faux); i++)
 1779:             {
 1780:                 difference = (((real8 *) (*((struct_vecteur *)
 1781:                         (*s_objet_argument_1).objet)).tableau)[i] ==
 1782:                         ((real8 *) (*((struct_vecteur *)
 1783:                         (*s_objet_argument_2).objet)).tableau)[i])
 1784:                         ? d_faux : d_vrai;
 1785:             }
 1786: 
 1787:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1788:                         d_faux) ? -1 : 0;
 1789:         }
 1790:     }
 1791: 
 1792:     /*
 1793:      * Vecteurs de complexes
 1794:      */
 1795: 
 1796:     else if (((*s_objet_argument_1).type == VCX) &&
 1797:             ((*s_objet_argument_2).type == VCX))
 1798:     {
 1799:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1800:         {
 1801:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1802:             return;
 1803:         }
 1804: 
 1805:         if ((*((struct_vecteur *) (*s_objet_argument_1).objet)).taille !=
 1806:                 (*((struct_vecteur *) (*s_objet_argument_2).objet)).taille)
 1807:         {
 1808:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1809:         }
 1810:         else
 1811:         {
 1812:             difference = d_faux;
 1813: 
 1814:             for(i = 0; (i < (*((struct_vecteur *) (*s_objet_argument_1).objet))
 1815:                     .taille) && (difference == d_faux); i++)
 1816:             {
 1817:                 difference = ((((struct_complexe16 *) (*((struct_vecteur *)
 1818:                         (*s_objet_argument_1).objet)).tableau)[i].partie_reelle
 1819:                         == ((struct_complexe16 *) (*((struct_vecteur *)
 1820:                         (*s_objet_argument_2).objet)).tableau)[i].partie_reelle)
 1821:                         && (((struct_complexe16 *) (*((struct_vecteur *)
 1822:                         (*s_objet_argument_1).objet)).tableau)[i]
 1823:                         .partie_imaginaire == ((struct_complexe16 *)
 1824:                         (*((struct_vecteur *) (*s_objet_argument_2).objet))
 1825:                         .tableau)[i].partie_imaginaire)) ? d_faux : d_vrai;
 1826:             }
 1827: 
 1828:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1829:                         d_faux) ? -1 : 0;
 1830:         }
 1831:     }
 1832: 
 1833: /*
 1834: --------------------------------------------------------------------------------
 1835:   SAME portant sur des matrices
 1836: --------------------------------------------------------------------------------
 1837: */
 1838:     /*
 1839:      * Matrice d'entiers
 1840:      */
 1841: 
 1842:     else if (((*s_objet_argument_1).type == MIN) &&
 1843:             ((*s_objet_argument_2).type == MIN))
 1844:     {
 1845:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1846:         {
 1847:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1848:             return;
 1849:         }
 1850: 
 1851:         if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
 1852:                 != (*((struct_matrice *) (*s_objet_argument_2).objet))
 1853:                 .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
 1854:                 .objet)).nombre_colonnes != (*((struct_matrice *)
 1855:                 (*s_objet_argument_2).objet)).nombre_colonnes))
 1856:         {
 1857:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1858:         }
 1859:         else
 1860:         {
 1861:             difference = d_faux;
 1862: 
 1863:             for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
 1864:                     .nombre_lignes) && (difference == d_faux); i++)
 1865:             {
 1866:                 for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
 1867:                         .objet)).nombre_colonnes) && (difference == d_faux);
 1868:                         j++)
 1869:                 {
 1870:                     difference = (((integer8 **) (*((struct_matrice *)
 1871:                             (*s_objet_argument_1).objet)).tableau)[i][j] ==
 1872:                             ((integer8 **) (*((struct_matrice *)
 1873:                             (*s_objet_argument_2).objet)).tableau)[i][j])
 1874:                             ? d_faux : d_vrai;
 1875:                 }
 1876:             }
 1877: 
 1878:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1879:                         d_faux) ? -1 : 0;
 1880:         }
 1881:     }
 1882: 
 1883:     /*
 1884:      * Matrice de réels
 1885:      */
 1886: 
 1887:     else if (((*s_objet_argument_1).type == MRL) &&
 1888:             ((*s_objet_argument_2).type == MRL))
 1889:     {
 1890:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1891:         {
 1892:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1893:             return;
 1894:         }
 1895: 
 1896:         if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
 1897:                 != (*((struct_matrice *) (*s_objet_argument_2).objet))
 1898:                 .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
 1899:                 .objet)).nombre_colonnes != (*((struct_matrice *)
 1900:                 (*s_objet_argument_2).objet)).nombre_colonnes))
 1901:         {
 1902:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1903:         }
 1904:         else
 1905:         {
 1906:             difference = d_faux;
 1907: 
 1908:             for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
 1909:                     .nombre_lignes) && (difference == d_faux); i++)
 1910:             {
 1911:                 for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
 1912:                         .objet)).nombre_colonnes) && (difference == d_faux);
 1913:                         j++)
 1914:                 {
 1915:                     difference = (((real8 **) (*((struct_matrice *)
 1916:                             (*s_objet_argument_1).objet)).tableau)[i][j] ==
 1917:                             ((real8 **) (*((struct_matrice *)
 1918:                             (*s_objet_argument_2).objet)).tableau)[i][j])
 1919:                             ? d_faux : d_vrai;
 1920:                 }
 1921:             }
 1922: 
 1923:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1924:                         d_faux) ? -1 : 0;
 1925:         }
 1926:     }
 1927: 
 1928:     /*
 1929:      * Matrice de complexes
 1930:      */
 1931: 
 1932:     else if (((*s_objet_argument_1).type == MCX) &&
 1933:             ((*s_objet_argument_2).type == MCX))
 1934:     {
 1935:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1936:         {
 1937:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1938:             return;
 1939:         }
 1940: 
 1941:         if (((*((struct_matrice *) (*s_objet_argument_1).objet)).nombre_lignes
 1942:                 != (*((struct_matrice *) (*s_objet_argument_2).objet))
 1943:                 .nombre_lignes) || ((*((struct_matrice *) (*s_objet_argument_1)
 1944:                 .objet)).nombre_colonnes != (*((struct_matrice *)
 1945:                 (*s_objet_argument_2).objet)).nombre_colonnes))
 1946:         {
 1947:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 1948:         }
 1949:         else
 1950:         {
 1951:             difference = d_faux;
 1952: 
 1953:             for(i = 0; (i < (*((struct_matrice *) (*s_objet_argument_1).objet))
 1954:                     .nombre_lignes) && (difference == d_faux); i++)
 1955:             {
 1956:                 for(j = 0; (j < (*((struct_matrice *) (*s_objet_argument_1)
 1957:                         .objet)).nombre_colonnes) && (difference == d_faux);
 1958:                         j++)
 1959:                 {
 1960:                     difference = ((((struct_complexe16 **) (*((struct_matrice *)
 1961:                             (*s_objet_argument_1).objet)).tableau)[i][j]
 1962:                             .partie_reelle == ((struct_complexe16 **)
 1963:                             (*((struct_matrice *) (*s_objet_argument_2).objet))
 1964:                             .tableau)[i][j].partie_reelle) &&
 1965:                             (((struct_complexe16 **) (*((struct_matrice *)
 1966:                             (*s_objet_argument_1).objet)).tableau)[i][j]
 1967:                             .partie_imaginaire == ((struct_complexe16 **)
 1968:                             (*((struct_matrice *) (*s_objet_argument_2).objet))
 1969:                             .tableau)[i][j].partie_imaginaire))
 1970:                             ? d_faux : d_vrai;
 1971:                 }
 1972:             }
 1973: 
 1974:             (*((integer8 *) (*s_objet_resultat).objet)) = (difference ==
 1975:                         d_faux) ? -1 : 0;
 1976:         }
 1977:     }
 1978: 
 1979: /*
 1980: --------------------------------------------------------------------------------
 1981:   SAME portant sur des noms (instruction "SAME")
 1982: --------------------------------------------------------------------------------
 1983: */
 1984: 
 1985:     else if (((*s_objet_argument_1).type == NOM) &&
 1986:             ((*s_objet_argument_2).type == NOM) &&
 1987:             (strcmp((*s_etat_processus).instruction_courante, "==") != 0))
 1988:     {
 1989:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 1990:         {
 1991:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 1992:             return;
 1993:         }
 1994: 
 1995:         (*((integer8 *) (*s_objet_resultat).objet)) =
 1996:                 (strcmp((*((struct_nom *) (*s_objet_argument_1).objet)).nom,
 1997:                 (*((struct_nom *) (*s_objet_argument_2).objet)).nom) == 0)
 1998:                 ? -1 : 0;
 1999:     }
 2000: 
 2001: /*
 2002: --------------------------------------------------------------------------------
 2003:   SAME entre des arguments complexes (instruction '==')
 2004: --------------------------------------------------------------------------------
 2005: */
 2006: 
 2007:     /*
 2008:      * Nom ou valeur numérique / Nom ou valeur numérique
 2009:      */
 2010: 
 2011:     else if (((((*s_objet_argument_1).type == NOM) &&
 2012:             (((*s_objet_argument_2).type == NOM) ||
 2013:             ((*s_objet_argument_2).type == INT) ||
 2014:             ((*s_objet_argument_2).type == REL))) ||
 2015:             (((*s_objet_argument_2).type == NOM) &&
 2016:             (((*s_objet_argument_1).type == INT) ||
 2017:             ((*s_objet_argument_1).type == REL)))) &&
 2018:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0))
 2019:     {
 2020:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 2021:         {
 2022:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2023:             return;
 2024:         }
 2025: 
 2026:         if (((*s_objet_resultat).objet =
 2027:                 allocation_maillon(s_etat_processus)) == NULL)
 2028:         {
 2029:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2030:             return;
 2031:         }
 2032: 
 2033:         l_element_courant = (*s_objet_resultat).objet;
 2034: 
 2035:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2036:                 == NULL)
 2037:         {
 2038:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2039:             return;
 2040:         }
 2041: 
 2042:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2043:                 .nombre_arguments = 0;
 2044:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2045:                 .fonction = instruction_vers_niveau_superieur;
 2046: 
 2047:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2048:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2049:         {
 2050:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2051:             return;
 2052:         }
 2053: 
 2054:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2055:                 .nom_fonction, "<<");
 2056: 
 2057:         if (((*l_element_courant).suivant =
 2058:                 allocation_maillon(s_etat_processus)) == NULL)
 2059:         {
 2060:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2061:             return;
 2062:         }
 2063: 
 2064:         l_element_courant = (*l_element_courant).suivant;
 2065:         (*l_element_courant).donnee = s_objet_argument_2;
 2066: 
 2067:         if (((*l_element_courant).suivant =
 2068:                 allocation_maillon(s_etat_processus)) == NULL)
 2069:         {
 2070:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2071:             return;
 2072:         }
 2073: 
 2074:         l_element_courant = (*l_element_courant).suivant;
 2075:         (*l_element_courant).donnee = s_objet_argument_1;
 2076: 
 2077:         if (((*l_element_courant).suivant =
 2078:                 allocation_maillon(s_etat_processus)) == NULL)
 2079:         {
 2080:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2081:             return;
 2082:         }
 2083: 
 2084:         l_element_courant = (*l_element_courant).suivant;
 2085: 
 2086:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2087:                 == NULL)
 2088:         {
 2089:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2090:             return;
 2091:         }
 2092: 
 2093:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2094:                 .nombre_arguments = 0;
 2095:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2096:                 .fonction = instruction_same;
 2097: 
 2098:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2099:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2100:         {
 2101:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2102:             return;
 2103:         }
 2104: 
 2105:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2106:                 .nom_fonction, "==");
 2107: 
 2108:         if (((*l_element_courant).suivant =
 2109:                 allocation_maillon(s_etat_processus)) == NULL)
 2110:         {
 2111:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2112:             return;
 2113:         }
 2114: 
 2115:         l_element_courant = (*l_element_courant).suivant;
 2116: 
 2117:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2118:                 == NULL)
 2119:         {
 2120:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2121:             return;
 2122:         }
 2123: 
 2124:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2125:                 .nombre_arguments = 0;
 2126:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2127:                 .fonction = instruction_vers_niveau_inferieur;
 2128: 
 2129:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2130:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 2131:         {
 2132:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2133:             return;
 2134:         }
 2135: 
 2136:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2137:                 .nom_fonction, ">>");
 2138: 
 2139:         (*l_element_courant).suivant = NULL;
 2140: 
 2141:         s_objet_argument_1 = NULL;
 2142:         s_objet_argument_2 = NULL;
 2143:     }
 2144: 
 2145:     /*
 2146:      * Nom ou valeur numérique / Expression
 2147:      */
 2148: 
 2149:     else if (((((*s_objet_argument_1).type == ALG) ||
 2150:             ((*s_objet_argument_1).type == RPN)) &&
 2151:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) &&
 2152:             (((*s_objet_argument_2).type == NOM) ||
 2153:             ((*s_objet_argument_2).type == INT) ||
 2154:             ((*s_objet_argument_2).type == REL)))
 2155:     {
 2156:         nombre_elements = 0;
 2157:         l_element_courant = (struct_liste_chainee *)
 2158:                 (*s_objet_argument_1).objet;
 2159: 
 2160:         while(l_element_courant != NULL)
 2161:         {
 2162:             nombre_elements++;
 2163:             l_element_courant = (*l_element_courant).suivant;
 2164:         }
 2165: 
 2166:         if (nombre_elements == 2)
 2167:         {
 2168:             liberation(s_etat_processus, s_objet_argument_1);
 2169:             liberation(s_etat_processus, s_objet_argument_2);
 2170: 
 2171:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2172:             return;
 2173:         }
 2174: 
 2175:         if ((s_objet_resultat = copie_objet(s_etat_processus,
 2176:                 s_objet_argument_1, 'N')) == NULL)
 2177:         {
 2178:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2179:             return;
 2180:         }
 2181: 
 2182:         l_element_courant = (struct_liste_chainee *)
 2183:                 (*s_objet_resultat).objet;
 2184:         l_element_precedent = l_element_courant;
 2185:         l_element_courant = (*l_element_courant).suivant;
 2186: 
 2187:         if (((*l_element_precedent).suivant =
 2188:                 allocation_maillon(s_etat_processus)) == NULL)
 2189:         {
 2190:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2191:             return;
 2192:         }
 2193: 
 2194:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_2;
 2195:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2196: 
 2197:         while((*l_element_courant).suivant != NULL)
 2198:         {
 2199:             l_element_precedent = l_element_courant;
 2200:             l_element_courant = (*l_element_courant).suivant;
 2201:         }
 2202: 
 2203:         if (((*l_element_precedent).suivant =
 2204:                 allocation_maillon(s_etat_processus)) == NULL)
 2205:         {
 2206:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2207:             return;
 2208:         }
 2209: 
 2210:         if (((*(*l_element_precedent).suivant).donnee =
 2211:                 allocation(s_etat_processus, FCT)) == NULL)
 2212:         {
 2213:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2214:             return;
 2215:         }
 2216: 
 2217:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2218:                 .donnee).objet)).nombre_arguments = 0;
 2219:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2220:                 .donnee).objet)).fonction = instruction_same;
 2221: 
 2222:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2223:                 .suivant).donnee).objet)).nom_fonction =
 2224:                 malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
 2225:                 sizeof(unsigned char))) == NULL)
 2226:         {
 2227:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2228:             return;
 2229:         }
 2230: 
 2231:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2232:                 .suivant).donnee).objet)).nom_fonction,
 2233:                 (*s_etat_processus).instruction_courante);
 2234: 
 2235:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2236: 
 2237:         s_objet_argument_2 = NULL;
 2238:     }
 2239: 
 2240:     /*
 2241:      * Expression / Nom ou valeur numérique
 2242:      */
 2243: 
 2244:     else if ((((*s_objet_argument_1).type == NOM) ||
 2245:             ((*s_objet_argument_1).type == INT) ||
 2246:             ((*s_objet_argument_1).type == REL)) &&
 2247:             ((((*s_objet_argument_2).type == ALG) ||
 2248:             ((*s_objet_argument_2).type == RPN)) &&
 2249:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0)))
 2250:     {
 2251:         nombre_elements = 0;
 2252:         l_element_courant = (struct_liste_chainee *)
 2253:                 (*s_objet_argument_2).objet;
 2254: 
 2255:         while(l_element_courant != NULL)
 2256:         {
 2257:             nombre_elements++;
 2258:             l_element_courant = (*l_element_courant).suivant;
 2259:         }
 2260: 
 2261:         if (nombre_elements == 2)
 2262:         {
 2263:             liberation(s_etat_processus, s_objet_argument_1);
 2264:             liberation(s_etat_processus, s_objet_argument_2);
 2265: 
 2266:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2267:             return;
 2268:         }
 2269: 
 2270:         if ((s_objet_resultat = copie_objet(s_etat_processus,
 2271:                 s_objet_argument_2, 'N')) == NULL)
 2272:         {
 2273:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2274:             return;
 2275:         }
 2276: 
 2277:         l_element_courant = (struct_liste_chainee *)
 2278:                 (*s_objet_resultat).objet;
 2279:         l_element_precedent = l_element_courant;
 2280: 
 2281:         while((*l_element_courant).suivant != NULL)
 2282:         {
 2283:             l_element_precedent = l_element_courant;
 2284:             l_element_courant = (*l_element_courant).suivant;
 2285:         }
 2286: 
 2287:         if (((*l_element_precedent).suivant =
 2288:                 allocation_maillon(s_etat_processus)) == NULL)
 2289:         {
 2290:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2291:             return;
 2292:         }
 2293: 
 2294:         (*(*l_element_precedent).suivant).donnee = s_objet_argument_1;
 2295:         l_element_precedent = (*l_element_precedent).suivant;
 2296: 
 2297:         if (((*l_element_precedent).suivant =
 2298:                 allocation_maillon(s_etat_processus)) == NULL)
 2299:         {
 2300:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2301:             return;
 2302:         }
 2303: 
 2304:         if (((*(*l_element_precedent).suivant).donnee =
 2305:                 allocation(s_etat_processus, FCT)) == NULL)
 2306:         {
 2307:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2308:             return;
 2309:         }
 2310: 
 2311:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2312:                 .donnee).objet)).nombre_arguments = 0;
 2313:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 2314:                 .donnee).objet)).fonction = instruction_same;
 2315: 
 2316:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 2317:                 .suivant).donnee).objet)).nom_fonction =
 2318:                 malloc((strlen((*s_etat_processus).instruction_courante) + 1) *
 2319:                 sizeof(unsigned char))) == NULL)
 2320:         {
 2321:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2322:             return;
 2323:         }
 2324: 
 2325:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 2326:                 .suivant).donnee).objet)).nom_fonction,
 2327:                 (*s_etat_processus).instruction_courante);
 2328: 
 2329:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2330: 
 2331:         s_objet_argument_1 = NULL;
 2332:     }
 2333: 
 2334:     /*
 2335:      * Expression / Expression
 2336:      */
 2337: 
 2338:     else if ((((*s_objet_argument_1).type == ALG) &&
 2339:             ((*s_objet_argument_2).type == ALG) &&
 2340:             (strcmp((*s_etat_processus).instruction_courante, "==") == 0)) ||
 2341:             (((*s_objet_argument_1).type == RPN) &&
 2342:             ((*s_objet_argument_2).type == RPN)))
 2343:     {
 2344:         nombre_elements = 0;
 2345:         l_element_courant = (struct_liste_chainee *)
 2346:                 (*s_objet_argument_1).objet;
 2347: 
 2348:         while(l_element_courant != NULL)
 2349:         {
 2350:             nombre_elements++;
 2351:             l_element_courant = (*l_element_courant).suivant;
 2352:         }
 2353: 
 2354:         if (nombre_elements == 2)
 2355:         {
 2356:             liberation(s_etat_processus, s_objet_argument_1);
 2357:             liberation(s_etat_processus, s_objet_argument_2);
 2358: 
 2359:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2360:             return;
 2361:         }
 2362: 
 2363:         nombre_elements = 0;
 2364:         l_element_courant = (struct_liste_chainee *)
 2365:                 (*s_objet_argument_2).objet;
 2366: 
 2367:         while(l_element_courant != NULL)
 2368:         {
 2369:             nombre_elements++;
 2370:             l_element_courant = (*l_element_courant).suivant;
 2371:         }
 2372: 
 2373:         if (nombre_elements == 2)
 2374:         {
 2375:             liberation(s_etat_processus, s_objet_argument_1);
 2376:             liberation(s_etat_processus, s_objet_argument_2);
 2377: 
 2378:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 2379:             return;
 2380:         }
 2381: 
 2382:         if ((s_copie_argument_1 = copie_objet(s_etat_processus,
 2383:                 s_objet_argument_1, 'N')) == NULL)
 2384:         {
 2385:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2386:             return;
 2387:         }
 2388: 
 2389:         if ((s_copie_argument_2 = copie_objet(s_etat_processus,
 2390:                 s_objet_argument_2, 'N')) == NULL)
 2391:         {
 2392:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2393:             return;
 2394:         }
 2395: 
 2396:         l_element_courant = (struct_liste_chainee *)
 2397:                 (*s_copie_argument_1).objet;
 2398:         (*s_copie_argument_1).objet = (void *) (*((struct_liste_chainee *)
 2399:                 (*s_copie_argument_1).objet)).suivant;
 2400: 
 2401:         liberation(s_etat_processus, (*l_element_courant).donnee);
 2402:         free(l_element_courant);
 2403: 
 2404:         l_element_courant = (struct_liste_chainee *)
 2405:                 (*s_copie_argument_2).objet;
 2406:         l_element_precedent = l_element_courant;
 2407:         s_objet_resultat = s_copie_argument_2;
 2408: 
 2409:         while((*l_element_courant).suivant != NULL)
 2410:         {
 2411:             l_element_precedent = l_element_courant;
 2412:             l_element_courant = (*l_element_courant).suivant;
 2413:         }
 2414: 
 2415:         liberation(s_etat_processus, (*l_element_courant).donnee);
 2416:         free(l_element_courant);
 2417: 
 2418:         (*l_element_precedent).suivant = (struct_liste_chainee *)
 2419:                 (*s_copie_argument_1).objet;
 2420:         free(s_copie_argument_1);
 2421: 
 2422:         l_element_courant = (*l_element_precedent).suivant;
 2423:         while((*l_element_courant).suivant != NULL)
 2424:         {
 2425:             l_element_precedent = l_element_courant;
 2426:             l_element_courant = (*l_element_courant).suivant;
 2427:         }
 2428: 
 2429:         if (((*l_element_precedent).suivant =
 2430:                 allocation_maillon(s_etat_processus)) == NULL)
 2431:         {
 2432:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2433:             return;
 2434:         }
 2435: 
 2436:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 2437:         l_element_courant = (*l_element_precedent).suivant;
 2438: 
 2439:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 2440:                 == NULL)
 2441:         {
 2442:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2443:             return;
 2444:         }
 2445: 
 2446:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2447:                 .nombre_arguments = 0;
 2448:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2449:                 .fonction = instruction_same;
 2450: 
 2451:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2452:                 .nom_fonction = malloc((strlen(
 2453:                 (*s_etat_processus).instruction_courante) + 1) *
 2454:                 sizeof(unsigned char))) == NULL)
 2455:         {
 2456:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2457:             return;
 2458:         }
 2459: 
 2460:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 2461:                 .nom_fonction, (*s_etat_processus).instruction_courante);
 2462:     }
 2463: 
 2464: /*
 2465: --------------------------------------------------------------------------------
 2466:   SAME nul
 2467: --------------------------------------------------------------------------------
 2468: */
 2469: 
 2470:     else
 2471:     {
 2472:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 2473:         {
 2474:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2475:             return;
 2476:         }
 2477: 
 2478:         (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 2479:     }
 2480: 
 2481:     liberation(s_etat_processus, s_objet_argument_1);
 2482:     liberation(s_etat_processus, s_objet_argument_2);
 2483: 
 2484:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2485:             s_objet_resultat) == d_erreur)
 2486:     {
 2487:         return;
 2488:     }
 2489: 
 2490:     return;
 2491: }
 2492: 
 2493: 
 2494: /*
 2495: ================================================================================
 2496:   Fonction 'start'
 2497: ================================================================================
 2498:   Entrées : structure processus
 2499: --------------------------------------------------------------------------------
 2500:   Sorties :
 2501: --------------------------------------------------------------------------------
 2502:   Effets de bord : néant
 2503: ================================================================================
 2504: */
 2505: 
 2506: void
 2507: instruction_start(struct_processus *s_etat_processus)
 2508: {
 2509:     struct_objet                            *s_objet_1;
 2510:     struct_objet                            *s_objet_2;
 2511: 
 2512:     (*s_etat_processus).erreur_execution = d_ex;
 2513: 
 2514:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2515:     {
 2516:         printf("\n  START ");
 2517: 
 2518:         if ((*s_etat_processus).langue == 'F')
 2519:         {
 2520:             printf("(boucle définie sans compteur)\n\n");
 2521:         }
 2522:         else
 2523:         {
 2524:             printf("(define a loop without counter)\n\n");
 2525:         }
 2526: 
 2527:         if ((*s_etat_processus).langue == 'F')
 2528:         {
 2529:             printf("  Utilisation :\n\n");
 2530:         }
 2531:         else
 2532:         {
 2533:             printf("  Usage:\n\n");
 2534:         }
 2535: 
 2536:         printf("    %s/%s %s/%s START\n", d_INT, d_REL,
 2537:                 d_INT, d_REL);
 2538:         printf("        (expression)\n");
 2539:         printf("        [EXIT]/[CYCLE]\n");
 2540:         printf("        ...\n");
 2541:         printf("    NEXT\n\n");
 2542: 
 2543:         printf("    %s/%s %s/%s START\n", d_INT, d_REL,
 2544:                 d_INT, d_REL);
 2545:         printf("        (expression)\n");
 2546:         printf("        [EXIT]/[CYCLE]\n");
 2547:         printf("        ...\n");
 2548:         printf("    %s/%s STEP\n", d_INT, d_REL);
 2549: 
 2550:         return;
 2551:     }
 2552:     else if ((*s_etat_processus).test_instruction == 'Y')
 2553:     {
 2554:         (*s_etat_processus).nombre_arguments = -1;
 2555:         return;
 2556:     }
 2557: 
 2558:     if ((*s_etat_processus).erreur_systeme != d_es)
 2559:     {
 2560:         return;
 2561:     }
 2562: 
 2563:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2564:     {
 2565:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 2566:         {
 2567:             return;
 2568:         }
 2569:     }
 2570: 
 2571:     empilement_pile_systeme(s_etat_processus);
 2572:     (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'S';
 2573: 
 2574:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2575:             &s_objet_1) == d_erreur)
 2576:     {
 2577:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2578:         return;
 2579:     }
 2580: 
 2581:     if (((*s_objet_1).type != INT) &&
 2582:             ((*s_objet_1).type != REL))
 2583:     {
 2584:         liberation(s_etat_processus, s_objet_1);
 2585: 
 2586:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2587:         return;
 2588:     }
 2589: 
 2590:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2591:             &s_objet_2) == d_erreur)
 2592:     {
 2593:         liberation(s_etat_processus, s_objet_1);
 2594: 
 2595:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2596:         return;
 2597:     }
 2598: 
 2599:     if (((*s_objet_2).type != INT) &&
 2600:             ((*s_objet_2).type != REL))
 2601:     {
 2602:         liberation(s_etat_processus, s_objet_1);
 2603:         liberation(s_etat_processus, s_objet_2);
 2604: 
 2605:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2606:         return;
 2607:     }
 2608: 
 2609:     (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet_2;
 2610:     (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
 2611: 
 2612:     if ((*s_etat_processus).mode_execution_programme == 'Y')
 2613:     {
 2614:         (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
 2615:                 (*s_etat_processus).position_courante;
 2616:         (*(*s_etat_processus).l_base_pile_systeme)
 2617:                 .origine_routine_evaluation = 'N';
 2618:     }
 2619:     else
 2620:     {
 2621:         (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
 2622:                 (*s_etat_processus).expression_courante;
 2623:         (*(*s_etat_processus).l_base_pile_systeme)
 2624:                 .origine_routine_evaluation = 'Y';
 2625:     }
 2626: 
 2627:     return;
 2628: }
 2629: 
 2630: 
 2631: /*
 2632: ================================================================================
 2633:   Fonction 'step'
 2634: ================================================================================
 2635:   Entrées : structure processus
 2636: --------------------------------------------------------------------------------
 2637:   Sorties :
 2638: --------------------------------------------------------------------------------
 2639:   Effets de bord : néant
 2640: ================================================================================
 2641: */
 2642: 
 2643: void
 2644: instruction_step(struct_processus *s_etat_processus)
 2645: {
 2646:     struct_objet                *s_objet;
 2647:     struct_objet                *s_copie_objet;
 2648: 
 2649:     logical1                    incrementation;
 2650:     logical1                    presence_compteur;
 2651: 
 2652:     (*s_etat_processus).erreur_execution = d_ex;
 2653: 
 2654:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2655:     {
 2656:         printf("\n  STEP ");
 2657: 
 2658:         if ((*s_etat_processus).langue == 'F')
 2659:         {
 2660:             printf("(fin d'une boucle définie)\n\n");
 2661:         }
 2662:         else
 2663:         {
 2664:             printf("(end of defined loop)\n\n");
 2665:         }
 2666: 
 2667:         if ((*s_etat_processus).langue == 'F')
 2668:         {
 2669:             printf("  Utilisation :\n\n");
 2670:         }
 2671:         else
 2672:         {
 2673:             printf("  Usage:\n\n");
 2674:         }
 2675: 
 2676:         printf("    %s/%s %s/%s START\n", d_INT, d_REL,
 2677:                 d_INT, d_REL);
 2678:         printf("        (expression)\n");
 2679:         printf("        [EXIT]/[CYCLE]\n");
 2680:         printf("        ...\n");
 2681:         printf("    (value) STEP\n\n");
 2682: 
 2683:         printf("    %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
 2684:                 d_INT, d_REL);
 2685:         printf("        (expression)\n");
 2686:         printf("        [EXIT]/[CYCLE]\n");
 2687:         printf("        ...\n");
 2688:         printf("    (value) STEP\n");
 2689: 
 2690:         return;
 2691:     }
 2692:     else if ((*s_etat_processus).test_instruction == 'Y')
 2693:     {
 2694:         (*s_etat_processus).nombre_arguments = -1;
 2695:         return;
 2696:     }
 2697: 
 2698:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2699:     {
 2700:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 2701:         {
 2702:             return;
 2703:         }
 2704:     }
 2705: 
 2706:     presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)
 2707:             .type_cloture == 'F') ? d_vrai : d_faux;
 2708: 
 2709:     if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
 2710:             && (presence_compteur == d_faux))
 2711:     {
 2712:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2713:         return;
 2714:     }
 2715: 
 2716:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2717:             &s_objet) == d_erreur)
 2718:     {
 2719:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2720:         return;
 2721:     }
 2722: 
 2723:     if (((*s_objet).type != INT) &&
 2724:             ((*s_objet).type != REL))
 2725:     {
 2726:         liberation(s_etat_processus, s_objet);
 2727: 
 2728:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2729:         return;
 2730:     }
 2731:     
 2732:     if ((*s_objet).type == INT)
 2733:     {
 2734:         incrementation = ((*((integer8 *) (*s_objet).objet)) >= 0)
 2735:                 ? d_vrai : d_faux;
 2736:     }
 2737:     else
 2738:     {
 2739:         incrementation = ((*((real8 *) (*s_objet).objet)) >= 0)
 2740:                 ? d_vrai : d_faux;
 2741:     }
 2742: 
 2743:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2744:             s_objet) == d_erreur)
 2745:     {
 2746:         return;
 2747:     }
 2748: 
 2749:     /*
 2750:      * Pour une boucle avec indice, on fait pointer
 2751:      * (*(*s_etat_processus).l_base_pile_systeme).indice_boucle sur
 2752:      * la variable correspondante. Remarque, le contenu de la variable
 2753:      * est détruit au courant de l'opération.
 2754:      */
 2755: 
 2756:     if (presence_compteur == d_vrai)
 2757:     {
 2758:         if (recherche_variable(s_etat_processus, (*(*s_etat_processus)
 2759:                 .l_base_pile_systeme).nom_variable) == d_faux)
 2760:         {
 2761:             liberation(s_etat_processus, s_objet);
 2762: 
 2763:             (*s_etat_processus).erreur_systeme = d_es;
 2764:             (*s_etat_processus).erreur_execution = d_ex_variable_non_definie;
 2765:             return;
 2766:         }
 2767: 
 2768:         if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2769:                 .position_variable_courante]).variable_verrouillee == d_vrai)
 2770:         {
 2771:             liberation(s_etat_processus, s_objet);
 2772: 
 2773:             (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
 2774:             return;
 2775:         }
 2776:     
 2777:         if (((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2778:                 .position_variable_courante]).objet == NULL)
 2779:         {
 2780:             liberation(s_etat_processus, s_objet);
 2781: 
 2782:             (*s_etat_processus).erreur_execution = d_ex_variable_partagee;
 2783:             return;
 2784:         }
 2785: 
 2786:         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
 2787:                 ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2788:                 .position_variable_courante]).objet;
 2789:     }
 2790: 
 2791:     /*
 2792:      * Empilement pour calculer le nouvel indice. Au passage, la
 2793:      * variable (*(*s_etat_processus).l_base_pile_systeme).indice_boucle
 2794:      * est libérée.
 2795:      */
 2796: 
 2797:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2798:             (*(*s_etat_processus).l_base_pile_systeme).indice_boucle)
 2799:             == d_erreur)
 2800:     {
 2801:         return;
 2802:     }
 2803: 
 2804:     instruction_plus(s_etat_processus);
 2805: 
 2806:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2807:             &s_objet) == d_erreur)
 2808:     {
 2809:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2810:         return;
 2811:     }
 2812: 
 2813:     if (((*s_objet).type != INT) &&
 2814:             ((*s_objet).type != REL))
 2815:     {
 2816:         liberation(s_etat_processus, s_objet);
 2817: 
 2818:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2819:         return;
 2820:     }
 2821:     
 2822:     if (presence_compteur == d_vrai)
 2823:     {
 2824:         /*
 2825:          * L'addition crée si besoin une copie de l'objet
 2826:          */
 2827: 
 2828:         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
 2829:         ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 2830:                 .position_variable_courante]).objet = s_objet;
 2831:     }
 2832:     else
 2833:     {
 2834:         (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = s_objet;
 2835:     }
 2836: 
 2837:     if ((s_copie_objet = copie_objet(s_etat_processus, s_objet, 'P')) == NULL)
 2838:     {
 2839:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2840:         return;
 2841:     }
 2842: 
 2843:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2844:             s_copie_objet) == d_erreur)
 2845:     {
 2846:         return;
 2847:     }
 2848: 
 2849:     if ((s_copie_objet = copie_objet(s_etat_processus,
 2850:             (*(*s_etat_processus).l_base_pile_systeme)
 2851:             .limite_indice_boucle, 'P')) == NULL)
 2852:     {
 2853:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 2854:         return;
 2855:     }
 2856: 
 2857:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2858:             s_copie_objet) == d_erreur)
 2859:     {
 2860:         return;
 2861:     }
 2862:     
 2863:     if (incrementation == d_vrai)
 2864:     {
 2865:         instruction_le(s_etat_processus);
 2866:     }
 2867:     else
 2868:     {
 2869:         instruction_ge(s_etat_processus);
 2870:     }
 2871: 
 2872:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2873:             &s_objet) == d_erreur)
 2874:     {
 2875:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2876:         return;
 2877:     }
 2878: 
 2879:     if ((*s_objet).type != INT)
 2880:     {
 2881:         liberation(s_etat_processus, s_objet);
 2882: 
 2883:         (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
 2884:         return;
 2885:     }
 2886: 
 2887:     if ((*((integer8 *) (*s_objet).objet)) != 0)
 2888:     {
 2889:         if ((*(*s_etat_processus).l_base_pile_systeme)
 2890:                 .origine_routine_evaluation == 'N')
 2891:         {
 2892:             (*s_etat_processus).position_courante = (*(*s_etat_processus)
 2893:                     .l_base_pile_systeme).adresse_retour;
 2894:         }
 2895:         else
 2896:         {
 2897:             (*s_etat_processus).expression_courante = (*(*s_etat_processus)
 2898:                     .l_base_pile_systeme).pointeur_objet_retour;
 2899:         }
 2900:     }
 2901:     else
 2902:     {
 2903:         depilement_pile_systeme(s_etat_processus);
 2904: 
 2905:         if ((*s_etat_processus).erreur_systeme != d_es)
 2906:         {
 2907:             return;
 2908:         }
 2909: 
 2910:         if (presence_compteur == d_vrai)
 2911:         {
 2912:             (*s_etat_processus).niveau_courant--;
 2913: 
 2914:             if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)
 2915:             {
 2916:                 return;
 2917:             }
 2918:         }
 2919:     }
 2920: 
 2921:     liberation(s_etat_processus, s_objet);
 2922: 
 2923:     return;
 2924: }
 2925: 
 2926: 
 2927: /*
 2928: ================================================================================
 2929:   Fonction 'sf'
 2930: ================================================================================
 2931:   Entrées : structure processus
 2932: --------------------------------------------------------------------------------
 2933:   Sorties :
 2934: --------------------------------------------------------------------------------
 2935:   Effets de bord : néant
 2936: ================================================================================
 2937: */
 2938: 
 2939: void
 2940: instruction_sf(struct_processus *s_etat_processus)
 2941: {
 2942:     struct_objet                            *s_objet;
 2943: 
 2944:     (*s_etat_processus).erreur_execution = d_ex;
 2945: 
 2946:     if ((*s_etat_processus).affichage_arguments == 'Y')
 2947:     {
 2948:         printf("\n  SF ");
 2949: 
 2950:         if ((*s_etat_processus).langue == 'F')
 2951:         {
 2952:             printf("(positionne un indicateur binaire)\n\n");
 2953:         }
 2954:         else
 2955:         {
 2956:             printf("(set flag)\n\n");
 2957:         }
 2958: 
 2959:         printf("    1: 1 <= %s <= 64\n", d_INT);
 2960: 
 2961:         return;
 2962:     }
 2963:     else if ((*s_etat_processus).test_instruction == 'Y')
 2964:     {
 2965:         (*s_etat_processus).nombre_arguments = -1;
 2966:         return;
 2967:     }
 2968: 
 2969:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 2970:     {
 2971:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 2972:         {
 2973:             return;
 2974:         }
 2975:     }
 2976: 
 2977:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 2978:             &s_objet) == d_erreur)
 2979:     {
 2980:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 2981:         return;
 2982:     }
 2983: 
 2984:     if ((*s_objet).type == INT)
 2985:     {
 2986:         if (((*((integer8 *) (*s_objet).objet)) < 1) || ((*((integer8 *)
 2987:                 (*s_objet).objet)) > 64))
 2988:         {
 2989:             liberation(s_etat_processus, s_objet);
 2990: 
 2991:             (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
 2992:             return;
 2993:         }
 2994: 
 2995:         sf(s_etat_processus, (unsigned char) (*((integer8 *)
 2996:                 (*s_objet).objet)));
 2997:     }
 2998:     else
 2999:     {
 3000:         liberation(s_etat_processus, s_objet);
 3001: 
 3002:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 3003:         return;
 3004:     }
 3005: 
 3006:     liberation(s_etat_processus, s_objet);
 3007: 
 3008:     return;
 3009: }
 3010: 
 3011: 
 3012: /*
 3013: ================================================================================
 3014:   Fonction 'stof'
 3015: ================================================================================
 3016:   Entrées : structure processus
 3017: --------------------------------------------------------------------------------
 3018:   Sorties :
 3019: --------------------------------------------------------------------------------
 3020:   Effets de bord : néant
 3021: ================================================================================
 3022: */
 3023: 
 3024: void
 3025: instruction_stof(struct_processus *s_etat_processus)
 3026: {
 3027:     struct_objet                            *s_objet;
 3028: 
 3029:     t_8_bits                                masque;
 3030: 
 3031:     unsigned char                           indice_bit;
 3032:     unsigned char                           indice_bloc;
 3033:     unsigned char                           indice_drapeau;
 3034:     unsigned char                           taille_bloc;
 3035: 
 3036:     unsigned long                           i;
 3037: 
 3038:     (*s_etat_processus).erreur_execution = d_ex;
 3039: 
 3040:     if ((*s_etat_processus).affichage_arguments == 'Y')
 3041:     {
 3042:         printf("\n  STOF ");
 3043: 
 3044:         if ((*s_etat_processus).langue == 'F')
 3045:         {
 3046:             printf("(positionne les drapeaux d'état)\n\n");
 3047:         }
 3048:         else
 3049:         {
 3050:             printf("(set flags)\n\n");
 3051:         }
 3052: 
 3053:         printf("->  1: %s\n", d_BIN);
 3054: 
 3055:         return;
 3056:     }
 3057:     else if ((*s_etat_processus).test_instruction == 'Y')
 3058:     {
 3059:         (*s_etat_processus).nombre_arguments = -1;
 3060:         return;
 3061:     }
 3062:     
 3063:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 3064:     {
 3065:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 3066:         {
 3067:             return;
 3068:         }
 3069:     }
 3070: 
 3071:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3072:             &s_objet) == d_erreur)
 3073:     {
 3074:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3075:         return;
 3076:     }
 3077: 
 3078:     if ((*s_objet).type == BIN)
 3079:     {
 3080:         taille_bloc = sizeof(t_8_bits) * 8;
 3081: 
 3082:         for(i = 0; i < 8; (*s_etat_processus).drapeaux_etat[i++] = 0);
 3083: 
 3084:         for(i = 1; i <= 64; i++)
 3085:         {
 3086:             indice_drapeau = i - 1;
 3087:             indice_bloc = indice_drapeau / taille_bloc;
 3088:             indice_bit = indice_drapeau % taille_bloc;
 3089:             masque = ((t_8_bits) 1) << (taille_bloc - indice_bit - 1);
 3090: 
 3091:             if (((*((logical8 *) (*s_objet).objet)) &
 3092:                     ((logical8) 1) << indice_drapeau) != 0)
 3093:             {
 3094:                 (*s_etat_processus).drapeaux_etat[indice_bloc] |= masque;
 3095:             }
 3096:         }
 3097:     }
 3098:     else
 3099:     {
 3100:         liberation(s_etat_processus, s_objet);
 3101: 
 3102:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 3103:         return;
 3104:     }
 3105: 
 3106:     liberation(s_etat_processus, s_objet);
 3107: 
 3108:     return;
 3109: }
 3110: 
 3111: 
 3112: /*
 3113: ================================================================================
 3114:   Fonction 'sto'
 3115: ================================================================================
 3116:   Entrées : structure processus
 3117: --------------------------------------------------------------------------------
 3118:   Sorties :
 3119: --------------------------------------------------------------------------------
 3120:   Effets de bord : néant
 3121: ================================================================================
 3122: */
 3123: 
 3124: void
 3125: instruction_sto(struct_processus *s_etat_processus)
 3126: {
 3127:     struct_objet                        *s_objet_1;
 3128:     struct_objet                        *s_objet_2;
 3129: 
 3130:     struct_variable                     s_variable;
 3131: 
 3132:     (*s_etat_processus).erreur_execution = d_ex;
 3133: 
 3134:     if ((*s_etat_processus).affichage_arguments == 'Y')
 3135:     {
 3136:         printf("\n  STO ");
 3137: 
 3138:         if ((*s_etat_processus).langue == 'F')
 3139:         {
 3140:             printf("(affecte un objet à une variable)\n\n");
 3141:         }
 3142:         else
 3143:         {
 3144:             printf("(store an object in a variable)\n\n");
 3145:         }
 3146: 
 3147:         printf("    2: %s, %s, %s, %s, %s, %s,\n"
 3148:                 "       %s, %s, %s, %s, %s,\n"
 3149:                 "       %s, %s, %s, %s, %s,\n"
 3150:                 "       %s, %s, %s, %s, %s,\n"
 3151:                 "       %s\n",
 3152:                 d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
 3153:                 d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
 3154:                 d_SLB, d_PRC, d_MTX, d_SQL);
 3155:         printf("    1: %s\n", d_NOM);
 3156: 
 3157:         return;
 3158:     }
 3159:     else if ((*s_etat_processus).test_instruction == 'Y')
 3160:     {
 3161:         (*s_etat_processus).nombre_arguments = -1;
 3162:         return;
 3163:     }
 3164:     
 3165:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 3166:     {
 3167:         if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
 3168:         {
 3169:             return;
 3170:         }
 3171:     }
 3172: 
 3173:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3174:             &s_objet_1) == d_erreur)
 3175:     {
 3176:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3177:         return;
 3178:     }
 3179: 
 3180:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3181:             &s_objet_2) == d_erreur)
 3182:     {
 3183:         liberation(s_etat_processus, s_objet_1);
 3184: 
 3185:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3186:         return;
 3187:     }
 3188: 
 3189:     if ((*s_objet_1).type != NOM)
 3190:     {
 3191:         liberation(s_etat_processus, s_objet_1);
 3192:         liberation(s_etat_processus, s_objet_2);
 3193: 
 3194:         (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
 3195:         return;
 3196:     }
 3197: 
 3198:     if (recherche_variable(s_etat_processus, (*((struct_nom *)
 3199:             (*s_objet_1).objet)).nom) == d_vrai)
 3200:     {
 3201:         /*
 3202:          * La variable est accessible.
 3203:          */
 3204: 
 3205:         if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3206:                 .position_variable_courante].variable_verrouillee == d_vrai)
 3207:         {
 3208:             liberation(s_etat_processus, s_objet_1);
 3209:             liberation(s_etat_processus, s_objet_2);
 3210: 
 3211:             (*s_etat_processus).erreur_execution = d_ex_variable_verrouillee;
 3212:             return;
 3213:         }
 3214: 
 3215:         if ((*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3216:                 .position_variable_courante].objet == NULL)
 3217:         {
 3218:             if (pthread_mutex_lock(&((*(*s_etat_processus)
 3219:                     .s_liste_variables_partagees).mutex)) != 0)
 3220:             {
 3221:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3222:                 return;
 3223:             }
 3224: 
 3225:             if (recherche_variable_partagee(s_etat_processus,
 3226:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3227:                     .position_variable_courante].nom,
 3228:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3229:                     .position_variable_courante].variable_partagee,
 3230:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3231:                     .position_variable_courante].origine) == d_faux)
 3232:             {
 3233:                 if (pthread_mutex_unlock(&((*(*s_etat_processus)
 3234:                         .s_liste_variables_partagees).mutex)) != 0)
 3235:                 {
 3236:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3237:                     return;
 3238:                 }
 3239: 
 3240:                 if ((s_variable.nom = malloc((strlen((*((struct_nom *)
 3241:                         (*s_objet_1).objet)).nom) + 1) *
 3242:                         sizeof(unsigned char))) == NULL)
 3243:                 {
 3244:                     (*s_etat_processus).erreur_systeme =
 3245:                             d_es_allocation_memoire;
 3246:                     return;
 3247:                 }
 3248: 
 3249:                 strcpy(s_variable.nom, (*((struct_nom *)
 3250:                         (*s_objet_1).objet)).nom);
 3251:                 s_variable.niveau = 1;
 3252: 
 3253:                 /*
 3254:                  * Le niveau 0 correspond aux définitions. Les variables
 3255:                  * commencent à 1 car elles sont toujours incluses dans
 3256:                  * une définition.
 3257:                  */
 3258: 
 3259:                 s_variable.objet = s_objet_2;
 3260: 
 3261:                 if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 3262:                         == d_erreur)
 3263:                 {
 3264:                     return;
 3265:                 }
 3266: 
 3267:                 (*s_etat_processus).erreur_systeme = d_es;
 3268:             }
 3269:             else
 3270:             {
 3271:                 liberation(s_etat_processus, (*(*s_etat_processus)
 3272:                         .s_liste_variables_partagees).table
 3273:                         [(*(*s_etat_processus).s_liste_variables_partagees)
 3274:                         .position_variable].objet);
 3275: 
 3276:                 (*(*s_etat_processus).s_liste_variables_partagees).table
 3277:                         [(*(*s_etat_processus).s_liste_variables_partagees)
 3278:                         .position_variable].objet = s_objet_2;
 3279: 
 3280:                 if (pthread_mutex_unlock(&((*(*s_etat_processus)
 3281:                         .s_liste_variables_partagees).mutex)) != 0)
 3282:                 {
 3283:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3284:                     return;
 3285:                 }
 3286:             }
 3287:         }
 3288:         else
 3289:         {
 3290:             liberation(s_etat_processus,
 3291:                     (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3292:                     .position_variable_courante].objet);
 3293: 
 3294:             (*s_etat_processus).s_liste_variables[(*s_etat_processus)
 3295:                     .position_variable_courante].objet = s_objet_2;
 3296:         }
 3297:     }
 3298:     else
 3299:     {
 3300:         /*
 3301:          * La variable n'est pas accessible ou n'existe pas et on crée
 3302:          * une variable globale.
 3303:          */
 3304: 
 3305:         if ((s_variable.nom = malloc((strlen((*((struct_nom *)
 3306:                 (*s_objet_1).objet)).nom) + 1) * sizeof(unsigned char)))
 3307:                 == NULL)
 3308:         {
 3309:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 3310:             return;
 3311:         }
 3312: 
 3313:         strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_1).objet)).nom);
 3314:         s_variable.niveau = 1;
 3315: 
 3316:         /*
 3317:          * Le niveau 0 correspond aux définitions. Les variables
 3318:          * commencent à 1 car elles sont toujours incluses dans
 3319:          * une définition.
 3320:          */
 3321: 
 3322:         s_variable.objet = s_objet_2;
 3323: 
 3324:         if (creation_variable(s_etat_processus, &s_variable, 'V', 'P')
 3325:                 == d_erreur)
 3326:         {
 3327:             return;
 3328:         }
 3329: 
 3330:         (*s_etat_processus).erreur_systeme = d_es;
 3331:     }
 3332: 
 3333:     liberation(s_etat_processus, s_objet_1);
 3334: 
 3335:     return;
 3336: }
 3337: 
 3338: 
 3339: /*
 3340: ================================================================================
 3341:   Fonction 'syseval'
 3342: ================================================================================
 3343:   Entrées : pointeur sur une struct_processus
 3344: --------------------------------------------------------------------------------
 3345:   Sorties :
 3346: --------------------------------------------------------------------------------
 3347:   Effets de bord : néant
 3348: ================================================================================
 3349: */
 3350: 
 3351: void
 3352: instruction_syseval(struct_processus *s_etat_processus)
 3353: {
 3354:     char                        **arguments;
 3355: 
 3356:     int                         ios;
 3357:     int                         pipes_entree[2];
 3358:     int                         pipes_erreur[2];
 3359:     int                         pipes_sortie[2];
 3360:     int                         status;
 3361: 
 3362:     logical1                    drapeau_fin;
 3363:     logical1                    presence_stdin;
 3364: 
 3365:     long                        i;
 3366:     long                        nombre_arguments;
 3367: 
 3368:     pid_t                       pid;
 3369: 
 3370:     sigset_t                    oldset;
 3371:     sigset_t                    set;
 3372: 
 3373:     ssize_t                     longueur_ecriture;
 3374: 
 3375:     struct_liste_chainee        *l_element_courant;
 3376:     struct_liste_chainee        *l_element_precedent;
 3377:     struct_liste_chainee        *l_element_stdin;
 3378: 
 3379:     struct_objet                *s_objet;
 3380:     struct_objet                *s_objet_composite;
 3381:     struct_objet                *s_objet_resultat;
 3382:     struct_objet                *s_objet_temporaire;
 3383: 
 3384:     struct sigaction            action_courante;
 3385:     struct sigaction            action_passee;
 3386: 
 3387:     unsigned char               *ptr;
 3388:     unsigned char               *ptr2;
 3389:     unsigned char               registre_autorisation_empilement_programme;
 3390:     unsigned char               *registre_instruction_courante;
 3391:     unsigned char               *registre_programme;
 3392:     unsigned char               *tampon;
 3393: 
 3394:     unsigned long               longueur_lecture;
 3395:     unsigned long               longueur_tampon;
 3396:     unsigned long               nombre_iterations;
 3397:     unsigned long               nombre_lignes;
 3398:     unsigned long               pointeur;
 3399:     unsigned long               registre_position_courante;
 3400: 
 3401:     (*s_etat_processus).erreur_execution = d_ex;
 3402: 
 3403:     if ((*s_etat_processus).affichage_arguments == 'Y')
 3404:     {
 3405:         printf("\n  SYSEVAL ");
 3406: 
 3407:         if ((*s_etat_processus).langue == 'F')
 3408:         {
 3409:             printf("(exécute une commande système)\n\n");
 3410:         }
 3411:         else
 3412:         {
 3413:             printf("(execute a shell command)\n\n");
 3414:         }
 3415: 
 3416:         printf("    1: %s\n", d_CHN);
 3417:         printf("->  1: %s\n\n", d_LST);
 3418: 
 3419:         printf("    1: %s\n", d_LST);
 3420:         printf("->  1: %s\n", d_LST);
 3421: 
 3422:         return;
 3423:     }
 3424:     else if ((*s_etat_processus).test_instruction == 'Y')
 3425:     {
 3426:         (*s_etat_processus).nombre_arguments = -1;
 3427:         return;
 3428:     }
 3429:     
 3430:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 3431:     {
 3432:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 3433:         {
 3434:             return;
 3435:         }
 3436:     }
 3437: 
 3438:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3439:             &s_objet) == d_erreur)
 3440:     {
 3441:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 3442:         return;
 3443:     }
 3444: 
 3445:     s_objet_composite = NULL;
 3446:     l_element_stdin = NULL;
 3447:     presence_stdin = d_faux;
 3448: 
 3449:     if ((*s_objet).type == LST)
 3450:     {
 3451:         s_objet_composite = s_objet;
 3452:         s_objet = (*((struct_liste_chainee *) (*s_objet_composite)
 3453:                 .objet)).donnee;
 3454:         l_element_stdin = (*((struct_liste_chainee *) (*s_objet_composite)
 3455:                 .objet)).suivant;
 3456: 
 3457:         l_element_courant = l_element_stdin;
 3458: 
 3459:         if (l_element_courant == NULL)
 3460:         {
 3461:             liberation(s_etat_processus, s_objet_composite);
 3462: 
 3463:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 3464:             return;
 3465:         }
 3466: 
 3467:         while(l_element_courant != NULL)
 3468:         {
 3469:             if ((*(*l_element_courant).donnee).type != CHN)
 3470:             {
 3471:                 liberation(s_etat_processus, s_objet_composite);
 3472: 
 3473:                 (*s_etat_processus).erreur_execution =
 3474:                         d_ex_erreur_type_argument;
 3475:                 return;
 3476:             }
 3477: 
 3478:             l_element_courant = (*l_element_courant).suivant;
 3479:         }
 3480: 
 3481:         presence_stdin = d_vrai;
 3482:     }
 3483: 
 3484:     if ((*s_objet).type == CHN)
 3485:     {
 3486:         registre_autorisation_empilement_programme =
 3487:                 (*s_etat_processus).autorisation_empilement_programme;
 3488:         registre_instruction_courante =
 3489:                 (*s_etat_processus).instruction_courante;
 3490:         registre_programme = (*s_etat_processus).definitions_chainees;
 3491:         registre_position_courante = (*s_etat_processus).position_courante;
 3492: 
 3493:         (*s_etat_processus).definitions_chainees =
 3494:                 (unsigned char *) (*s_objet).objet;
 3495:         (*s_etat_processus).position_courante = 0;
 3496:         (*s_etat_processus).autorisation_empilement_programme = 'N';
 3497: 
 3498:         /*
 3499:          * Échappement des guillemets
 3500:          */
 3501: 
 3502:         ptr = (*s_etat_processus).definitions_chainees;
 3503:         ptr2 = ptr;
 3504:         i = 0;
 3505: 
 3506:         while((*ptr) != d_code_fin_chaine)
 3507:         {
 3508:             if ((*ptr) == '\\')
 3509:             {
 3510:                 switch (*(ptr + 1))
 3511:                 {
 3512:                     case '"':
 3513:                     case '\\':
 3514:                     {
 3515:                         ptr++;
 3516:                         break;
 3517:                     }
 3518:                 }
 3519:             }
 3520: 
 3521:             *ptr2++ = *ptr++;
 3522:         }
 3523: 
 3524:         *ptr2 = d_code_fin_chaine;
 3525: 
 3526:         /*
 3527:          * Scission de la chaîne en différents arguments
 3528:          */
 3529: 
 3530:         nombre_arguments = 0;
 3531:         drapeau_fin = d_faux;
 3532: 
 3533:         do
 3534:         {
 3535:             if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
 3536:             {
 3537:                 (*s_etat_processus).autorisation_empilement_programme =
 3538:                         registre_autorisation_empilement_programme;
 3539:                 (*s_etat_processus).instruction_courante =
 3540:                         registre_instruction_courante;
 3541:                 (*s_etat_processus).definitions_chainees = registre_programme;
 3542:                 (*s_etat_processus).position_courante =
 3543:                         registre_position_courante;
 3544: 
 3545:                 return;
 3546:             }
 3547: 
 3548:             if ((*(*s_etat_processus).instruction_courante) !=
 3549:                     d_code_fin_chaine)
 3550:             {
 3551:                 if ((s_objet_temporaire = allocation(s_etat_processus, CHN))
 3552:                         == NULL)
 3553:                 {
 3554:                     (*s_etat_processus).autorisation_empilement_programme =
 3555:                             registre_autorisation_empilement_programme;
 3556:                     (*s_etat_processus).instruction_courante =
 3557:                             registre_instruction_courante;
 3558:                     (*s_etat_processus).definitions_chainees =
 3559:                             registre_programme;
 3560:                     (*s_etat_processus).position_courante =
 3561:                             registre_position_courante;
 3562: 
 3563:                     (*s_etat_processus).erreur_systeme =
 3564:                             d_es_allocation_memoire;
 3565:                     return;
 3566:                 }
 3567: 
 3568:                 (*s_objet_temporaire).objet = (*s_etat_processus)
 3569:                         .instruction_courante;
 3570: 
 3571:                 /*
 3572:                  * S'il y a des guillemets en début de chaîne, il y en
 3573:                  * a aussi à la fin de la chaîne et on les ôte. Les
 3574:                  * guillements intermédiaires sont protégés par une
 3575:                  * séquence d'échappement qui est enlevée.
 3576:                  */
 3577: 
 3578:                 if ((*s_etat_processus).instruction_courante[0] == '"')
 3579:                 {
 3580:                     if (strlen((*s_etat_processus).instruction_courante) >= 2)
 3581:                     {
 3582:                         ptr = (*s_etat_processus).instruction_courante;
 3583:                         ptr2 = ptr + 1;
 3584: 
 3585:                         while((*ptr2) != d_code_fin_chaine)
 3586:                         {
 3587:                             *ptr++ = *ptr2++;
 3588:                         }
 3589: 
 3590:                         (*(--ptr)) = d_code_fin_chaine;
 3591:                     }
 3592:                 }
 3593: 
 3594:                 if (empilement(s_etat_processus,
 3595:                         &((*s_etat_processus).l_base_pile),
 3596:                         s_objet_temporaire) == d_erreur)
 3597:                 {
 3598:                     return;
 3599:                 }
 3600:             }
 3601:             else
 3602:             {
 3603:                 free((*s_etat_processus).instruction_courante);
 3604:                 drapeau_fin = d_vrai;
 3605:             }
 3606: 
 3607:             nombre_arguments++;
 3608:         } while(drapeau_fin == d_faux);
 3609: 
 3610:         (*s_etat_processus).autorisation_empilement_programme =
 3611:                 registre_autorisation_empilement_programme;
 3612:         (*s_etat_processus).instruction_courante =
 3613:                 registre_instruction_courante;
 3614:         (*s_etat_processus).definitions_chainees = registre_programme;
 3615:         (*s_etat_processus).position_courante = registre_position_courante;
 3616: 
 3617:         if ((arguments = malloc(nombre_arguments * sizeof(char *))) == NULL)
 3618:         {
 3619:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 3620:             return;
 3621:         }
 3622: 
 3623:         l_element_courant = (*s_etat_processus).l_base_pile;
 3624:         nombre_arguments--;
 3625: 
 3626:         for(i = nombre_arguments, arguments[i--] = NULL; i >= 0; i--)
 3627:         {
 3628:             arguments[i] = (char *) (*(*l_element_courant).donnee).objet;
 3629:             l_element_courant = (*l_element_courant).suivant;
 3630:         }
 3631: 
 3632:         action_courante.sa_handler = SIG_IGN;
 3633:         action_courante.sa_flags = SA_NODEFER | SA_ONSTACK;
 3634: 
 3635:         if (sigaction(SIGINT, &action_courante, &action_passee) != 0)
 3636:         {
 3637:             for(i = 0; i < nombre_arguments; i++)
 3638:             {
 3639:                 depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3640:                         &s_objet_temporaire);
 3641:                 liberation(s_etat_processus, s_objet_temporaire);
 3642:             }
 3643: 
 3644:             free(arguments);
 3645:             (*s_etat_processus).erreur_systeme = d_es_signal;
 3646:             return;
 3647:         }
 3648: 
 3649:         if (pipe(pipes_entree) != 0)
 3650:         {
 3651:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3652:             return;
 3653:         }
 3654:             
 3655:         if (pipe(pipes_sortie) != 0)
 3656:         {
 3657:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3658:             return;
 3659:         }
 3660: 
 3661:         if (pipe(pipes_erreur) != 0)
 3662:         {
 3663:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3664:             return;
 3665:         }
 3666: 
 3667:         fflush(NULL);
 3668: 
 3669:         sigfillset(&set);
 3670:         pthread_sigmask(SIG_BLOCK, &set, &oldset);
 3671: 
 3672:         verrouillage_threads_concurrents(s_etat_processus);
 3673:         pid = fork();
 3674:         deverrouillage_threads_concurrents(s_etat_processus);
 3675: 
 3676:         pthread_sigmask(SIG_SETMASK, &oldset, NULL);
 3677:         sigpending(&set);
 3678: 
 3679:         if (pid < 0)
 3680:         {
 3681:             if (close(pipes_entree[0]) != 0)
 3682:             {
 3683:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3684:                 return;
 3685:             }
 3686: 
 3687:             if (close(pipes_entree[1]) != 0)
 3688:             {
 3689:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3690:                 return;
 3691:             }
 3692: 
 3693:             if (close(pipes_sortie[0]) != 0)
 3694:             {
 3695:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3696:                 return;
 3697:             }
 3698: 
 3699:             if (close(pipes_sortie[1]) != 0)
 3700:             {
 3701:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3702:                 return;
 3703:             }
 3704: 
 3705:             if (close(pipes_erreur[0]) != 0)
 3706:             {
 3707:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3708:                 return;
 3709:             }
 3710: 
 3711:             if (close(pipes_erreur[1]) != 0)
 3712:             {
 3713:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3714:                 return;
 3715:             }
 3716: 
 3717:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3718:             return;
 3719:         }
 3720:         else if (pid == 0)
 3721:         {
 3722:             if (close(pipes_entree[1]) != 0)
 3723:             {
 3724:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3725:                 return;
 3726:             }
 3727: 
 3728:             if (close(pipes_sortie[0]) != 0)
 3729:             {
 3730:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3731:                 return;
 3732:             }
 3733: 
 3734:             if (close(pipes_erreur[0]) != 0)
 3735:             {
 3736:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3737:                 return;
 3738:             }
 3739: 
 3740:             if (pipes_entree[0] != STDIN_FILENO)
 3741:             {
 3742:                 if (dup2(pipes_entree[0], STDIN_FILENO) == -1)
 3743:                 {
 3744:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3745:                     return;
 3746:                 }
 3747:             }
 3748: 
 3749:             if (pipes_sortie[1] != STDOUT_FILENO)
 3750:             {
 3751:                 if (dup2(pipes_sortie[1], STDOUT_FILENO) == -1)
 3752:                 {
 3753:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3754:                     return;
 3755:                 }
 3756:             }
 3757: 
 3758:             if (pipes_sortie[1] != STDERR_FILENO)
 3759:             {
 3760:                 if (dup2(pipes_sortie[1], STDERR_FILENO) == -1)
 3761:                 {
 3762:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3763:                     return;
 3764:                 }
 3765:             }
 3766: 
 3767:             if (nombre_arguments != 0)
 3768:             {
 3769:                 execvp(arguments[0], arguments);
 3770:             }
 3771:             else
 3772:             {
 3773:                 exit(EXIT_SUCCESS);
 3774:             }
 3775: 
 3776:             /*
 3777:              * L'appel système execvp() a généré une erreur et n'a pu exécuter
 3778:              * argument[0] (fichier non exécutable ou inexistant).
 3779:              */
 3780: 
 3781:             close(pipes_entree[0]);
 3782:             close(pipes_sortie[1]);
 3783: 
 3784:             for(i = 0; i < nombre_arguments; i++)
 3785:             {
 3786:                 depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 3787:                         &s_objet_temporaire);
 3788:                 liberation(s_etat_processus, s_objet_temporaire);
 3789:             }
 3790: 
 3791:             free(arguments);
 3792:             (*s_etat_processus).erreur_systeme = d_es_processus;
 3793: 
 3794:             /*
 3795:              * Envoi d'une erreur dans le pipe idoine. On ne regarde pas
 3796:              * le nombre d'octets écrits car l'erreur ne pourra de toute
 3797:              * façon pas être traitée.
 3798:              */
 3799: 
 3800:             write_atomic(s_etat_processus, pipes_erreur[1], " ", 1);
 3801:             close(pipes_erreur[1]);
 3802: 
 3803:             exit(EXIT_SUCCESS);
 3804:         }
 3805:         else
 3806:         {
 3807:             if (close(pipes_entree[0]) != 0)
 3808:             {
 3809:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3810:                 return;
 3811:             }
 3812: 
 3813:             if (close(pipes_sortie[1]) != 0)
 3814:             {
 3815:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3816:                 return;
 3817:             }
 3818: 
 3819:             if (close(pipes_erreur[1]) != 0)
 3820:             {
 3821:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3822:                 return;
 3823:             }
 3824: 
 3825:             if (presence_stdin == d_vrai)
 3826:             {
 3827:                 l_element_courant = l_element_stdin;
 3828: 
 3829:                 while(l_element_courant != NULL)
 3830:                 {
 3831:                     longueur_ecriture = strlen((unsigned char *)
 3832:                             (*(*l_element_courant).donnee).objet);
 3833: 
 3834:                     if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 3835:                     {
 3836:                         (*s_etat_processus).erreur_systeme = d_es_processus;
 3837:                         return;
 3838:                     }
 3839: 
 3840:                     while(write_atomic(s_etat_processus,
 3841:                             pipes_entree[1], (unsigned char *)
 3842:                             (*(*l_element_courant).donnee).objet,
 3843:                             longueur_ecriture) != longueur_ecriture)
 3844:                     {
 3845:                         while(sem_wait(&((*s_etat_processus)
 3846:                                 .semaphore_fork)) == -1)
 3847:                         {
 3848:                             if (errno != EINTR)
 3849:                             {
 3850:                                 (*s_etat_processus).erreur_systeme =
 3851:                                         d_es_processus;
 3852:                                 return;
 3853:                             }
 3854:                         }
 3855: 
 3856:                         if (longueur_ecriture == -1)
 3857:                         {
 3858:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3859:                             return;
 3860:                         }
 3861: 
 3862:                         if (sem_post(&((*s_etat_processus)
 3863:                                 .semaphore_fork)) != 0)
 3864:                         {
 3865:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3866:                             return;
 3867:                         }
 3868:                     }
 3869: 
 3870:                     while(write_atomic(s_etat_processus,
 3871:                             pipes_entree[1], "\n", 1) != 1)
 3872:                     {
 3873:                         while(sem_wait(&((*s_etat_processus)
 3874:                                 .semaphore_fork)) == -1)
 3875:                         {
 3876:                             if (errno != EINTR)
 3877:                             {
 3878:                                 (*s_etat_processus).erreur_systeme =
 3879:                                         d_es_processus;
 3880:                                 return;
 3881:                             }
 3882:                         }
 3883: 
 3884:                         if (longueur_ecriture == -1)
 3885:                         {
 3886:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3887:                             return;
 3888:                         }
 3889: 
 3890:                         if (sem_post(&((*s_etat_processus)
 3891:                                 .semaphore_fork)) != 0)
 3892:                         {
 3893:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3894:                             return;
 3895:                         }
 3896:                     }
 3897: 
 3898:                     while(sem_wait(&((*s_etat_processus).semaphore_fork))
 3899:                             == -1)
 3900:                     {
 3901:                         if (errno != EINTR)
 3902:                         {
 3903:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3904:                             return;
 3905:                         }
 3906:                     }
 3907: 
 3908:                     l_element_courant = (*l_element_courant).suivant;
 3909:                 }
 3910:             }
 3911: 
 3912:             if (close(pipes_entree[1]) != 0)
 3913:             {
 3914:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3915:                 return;
 3916:             }
 3917: 
 3918:             do
 3919:             {
 3920:                 if (kill(pid, 0) != 0)
 3921:                 {
 3922:                     break;
 3923:                 }
 3924: 
 3925:                 /*
 3926:                  * Récupération de la valeur de retour du processus détaché
 3927:                  */
 3928: 
 3929:                 if (sem_post(&((*s_etat_processus).semaphore_fork))
 3930:                         != 0)
 3931:                 {
 3932:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3933:                     return;
 3934:                 }
 3935: 
 3936:                 if (waitpid(pid, &status, 0) == -1)
 3937:                 {
 3938:                     if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 3939:                     {
 3940:                         if (errno != EINTR)
 3941:                         {
 3942:                             (*s_etat_processus).erreur_systeme = d_es_processus;
 3943:                             return;
 3944:                         }
 3945:                     }
 3946: 
 3947:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 3948:                     return;
 3949:                 }
 3950: 
 3951:                 if (sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 3952:                 {
 3953:                     if (errno != EINTR)
 3954:                     {
 3955:                         (*s_etat_processus).erreur_systeme = d_es_processus;
 3956:                         return;
 3957:                     }
 3958:                 }
 3959:             } while((!WIFEXITED(status)) && (!WIFSIGNALED(status)));
 3960: 
 3961:             longueur_lecture = 256;
 3962:             pointeur = 0;
 3963:             nombre_iterations = 1;
 3964: 
 3965:             if ((tampon = malloc((longueur_lecture + 1) *
 3966:                     sizeof(unsigned char))) == NULL)
 3967:             {
 3968:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 3969:                 return;
 3970:             }
 3971: 
 3972:             if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 3973:             {
 3974:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 3975:                 return;
 3976:             }
 3977: 
 3978:             while((ios = read_atomic(s_etat_processus,
 3979:                     pipes_sortie[0], &(tampon[pointeur]),
 3980:                     longueur_lecture)) > 0)
 3981:             {
 3982:                 while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 3983:                 {
 3984:                     if (errno != EINTR)
 3985:                     {
 3986:                         (*s_etat_processus).erreur_systeme = d_es_processus;
 3987:                         return;
 3988:                     }
 3989:                 }
 3990: 
 3991:                 tampon[pointeur + ios] = d_code_fin_chaine;
 3992:                 pointeur += longueur_lecture;
 3993:                 nombre_iterations++;
 3994: 
 3995:                 if ((tampon = realloc(tampon,
 3996:                         ((nombre_iterations * longueur_lecture) + 1) *
 3997:                         sizeof(unsigned char))) == NULL)
 3998:                 {
 3999:                     (*s_etat_processus).erreur_systeme =
 4000:                             d_es_allocation_memoire;
 4001:                     return;
 4002:                 }
 4003: 
 4004:                 if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 4005:                 {
 4006:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4007:                     return;
 4008:                 }
 4009:             }
 4010: 
 4011:             while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4012:             {
 4013:                 if (errno != EINTR)
 4014:                 {
 4015:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4016:                     return;
 4017:                 }
 4018:             }
 4019: 
 4020:             if ((tampon = realloc(tampon, (strlen(tampon) + 1) *
 4021:                     sizeof(unsigned char))) == NULL)
 4022:             {
 4023:                 (*s_etat_processus).erreur_systeme =
 4024:                         d_es_allocation_memoire;
 4025:                 return;
 4026:             }
 4027: 
 4028:             if (ios == -1)
 4029:             {
 4030:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4031:                 return;
 4032:             }
 4033: 
 4034:             if (close(pipes_sortie[0]) != 0)
 4035:             {
 4036:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4037:                 return;
 4038:             }
 4039: 
 4040:             /*
 4041:              * Transformation de la chaîne en liste
 4042:              */
 4043: 
 4044:             longueur_tampon = strlen(tampon);
 4045: 
 4046:             for(i = 0, ptr = tampon, nombre_lignes = 0;
 4047:                     i < (long) longueur_tampon; i++, ptr++)
 4048:             {
 4049:                 if ((*ptr) == d_code_retour_chariot)
 4050:                 {
 4051:                     nombre_lignes++;
 4052:                     (*ptr) = d_code_fin_chaine;
 4053:                 }
 4054:             }
 4055: 
 4056:             if ((s_objet_resultat = allocation(s_etat_processus, LST))
 4057:                     == NULL)
 4058:             {
 4059:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4060:                 return;
 4061:             }
 4062: 
 4063:             if (nombre_lignes == 0)
 4064:             {
 4065:                 (*s_objet_resultat).objet = NULL;
 4066:             }
 4067:             else
 4068:             {
 4069:                 if (((*s_objet_resultat).objet =
 4070:                         allocation_maillon(s_etat_processus)) == NULL)
 4071:                 {
 4072:                     (*s_etat_processus).erreur_systeme =
 4073:                             d_es_allocation_memoire;
 4074:                     return;
 4075:                 }
 4076: 
 4077:                 l_element_precedent = NULL;
 4078:                 l_element_courant = (struct_liste_chainee *)
 4079:                         (*s_objet_resultat).objet;
 4080: 
 4081:                 for(i = 0, ptr = tampon; i < (long) nombre_lignes; i++)
 4082:                 {
 4083:                     if (((*l_element_courant).donnee =
 4084:                             allocation(s_etat_processus, CHN)) == NULL)
 4085:                     {
 4086:                         (*s_etat_processus).erreur_systeme =
 4087:                                 d_es_allocation_memoire;
 4088:                         return;
 4089:                     }
 4090: 
 4091:                     if (((*(*l_element_courant).donnee).objet =
 4092:                             malloc((strlen(ptr) + 1) * sizeof(unsigned char)))
 4093:                             == NULL)
 4094:                     {
 4095:                         (*s_etat_processus).erreur_systeme =
 4096:                                 d_es_allocation_memoire;
 4097:                         return;
 4098:                     }
 4099: 
 4100:                     strcpy((*(*l_element_courant).donnee).objet, ptr);
 4101:                 
 4102:                     while((*ptr) != d_code_fin_chaine)
 4103:                     {
 4104:                         ptr++;
 4105:                     }
 4106: 
 4107:                     ptr++;
 4108: 
 4109:                     if (((*l_element_courant).suivant =
 4110:                             allocation_maillon(s_etat_processus)) == NULL)
 4111:                     {
 4112:                         (*s_etat_processus).erreur_systeme =
 4113:                                 d_es_allocation_memoire;
 4114:                         return;
 4115:                     }
 4116: 
 4117:                     l_element_precedent = l_element_courant;
 4118:                     l_element_courant = (*l_element_courant).suivant;
 4119:                 }
 4120: 
 4121:                 free(l_element_courant);
 4122: 
 4123:                 if (l_element_precedent != NULL)
 4124:                 {
 4125:                     (*l_element_precedent).suivant = NULL;
 4126:                 }
 4127:             }
 4128: 
 4129:             free(tampon);
 4130:         }
 4131: 
 4132:         if (sigaction(SIGINT, &action_passee, NULL) != 0)
 4133:         {
 4134:             for(i = 0; i < nombre_arguments; i++)
 4135:             {
 4136:                 depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4137:                         &s_objet_temporaire);
 4138:                 liberation(s_etat_processus, s_objet_temporaire);
 4139:             }
 4140: 
 4141:             free(arguments);
 4142:             (*s_etat_processus).erreur_systeme = d_es_signal;
 4143:             return;
 4144:         }
 4145: 
 4146:         for(i = 0; i < nombre_arguments; i++)
 4147:         {
 4148:             depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4149:                     &s_objet_temporaire);
 4150:             liberation(s_etat_processus, s_objet_temporaire);
 4151:         }
 4152: 
 4153:         if ((tampon = malloc(sizeof(unsigned char))) == NULL)
 4154:         {
 4155:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4156:             return;
 4157:         }
 4158:  
 4159:         if (sem_post(&((*s_etat_processus).semaphore_fork)) != 0)
 4160:         {
 4161:             (*s_etat_processus).erreur_systeme = d_es_processus;
 4162:             return;
 4163:         }
 4164: 
 4165:         if (read_atomic(s_etat_processus, pipes_erreur[0], tampon, 1) > 0)
 4166:         {
 4167:             // Le processus fils renvoie une erreur.
 4168: 
 4169:             (*s_etat_processus).erreur_execution = d_ex_erreur_processus;
 4170:             liberation(s_etat_processus, s_objet_resultat);
 4171:         }
 4172:         else if (empilement(s_etat_processus,
 4173:                 &((*s_etat_processus).l_base_pile), s_objet_resultat)
 4174:                 == d_erreur)
 4175:         {
 4176:             while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4177:             {
 4178:                 if (errno != EINTR)
 4179:                 {
 4180:                     (*s_etat_processus).erreur_systeme = d_es_processus;
 4181:                     return;
 4182:                 }
 4183:             }
 4184: 
 4185:             if (close(pipes_erreur[0]) != 0)
 4186:             {
 4187:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4188:                 return;
 4189:             }
 4190: 
 4191:             free(tampon);
 4192:             return;
 4193:         }
 4194: 
 4195:         while(sem_wait(&((*s_etat_processus).semaphore_fork)) == -1)
 4196:         {
 4197:             if (errno != EINTR)
 4198:             {
 4199:                 (*s_etat_processus).erreur_systeme = d_es_processus;
 4200:                 return;
 4201:             }
 4202:         }
 4203: 
 4204:         if (close(pipes_erreur[0]) != 0)
 4205:         {
 4206:             (*s_etat_processus).erreur_systeme = d_es_processus;
 4207:             return;
 4208:         }
 4209: 
 4210:         free(arguments);
 4211:         free(tampon);
 4212:     }
 4213:     else
 4214:     {
 4215:         if (presence_stdin == d_vrai)
 4216:         {
 4217:             s_objet = s_objet_composite;
 4218:         }
 4219: 
 4220:         liberation(s_etat_processus, s_objet);
 4221: 
 4222:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 4223:         return;
 4224:     }
 4225: 
 4226:     if (presence_stdin == d_vrai)
 4227:     {
 4228:         s_objet = s_objet_composite;
 4229:     }
 4230: 
 4231:     liberation(s_etat_processus, s_objet);
 4232: 
 4233:     return;
 4234: }
 4235: 
 4236: 
 4237: /*
 4238: ================================================================================
 4239:   Fonction 'sign'
 4240: ================================================================================
 4241:   Entrées :
 4242: --------------------------------------------------------------------------------
 4243:   Sorties :
 4244: --------------------------------------------------------------------------------
 4245:   Effets de bord : néant
 4246: ================================================================================
 4247: */
 4248: 
 4249: void
 4250: instruction_sign(struct_processus *s_etat_processus)
 4251: {
 4252:     real8                               norme;
 4253: 
 4254:     struct_liste_chainee                *l_element_courant;
 4255:     struct_liste_chainee                *l_element_precedent;
 4256: 
 4257:     struct_objet                        *s_copie_argument;
 4258:     struct_objet                        *s_objet_argument;
 4259:     struct_objet                        *s_objet_resultat;
 4260: 
 4261:     (*s_etat_processus).erreur_execution = d_ex;
 4262: 
 4263:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4264:     {
 4265:         printf("\n  SIGN ");
 4266: 
 4267:         if ((*s_etat_processus).langue == 'F')
 4268:         {
 4269:             printf("(signe)\n\n");
 4270:         }
 4271:         else
 4272:         {
 4273:             printf("(sign)\n\n");
 4274:         }
 4275: 
 4276:         printf("    1: %s, %s\n", d_INT, d_REL);
 4277:         printf("->  1: %s\n\n", d_INT);
 4278: 
 4279:         printf("    1: %s\n", d_CPL);
 4280:         printf("->  1: %s\n\n", d_CPL);
 4281: 
 4282:         printf("    1: %s, %s\n", d_NOM, d_ALG);
 4283:         printf("->  1: %s\n\n", d_ALG);
 4284: 
 4285:         printf("    1: %s\n", d_RPN);
 4286:         printf("->  1: %s\n", d_RPN);
 4287: 
 4288:         return;
 4289:     }
 4290:     else if ((*s_etat_processus).test_instruction == 'Y')
 4291:     {
 4292:         (*s_etat_processus).nombre_arguments = 1;
 4293:         return;
 4294:     }
 4295:     
 4296:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 4297:     {
 4298:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 4299:         {
 4300:             return;
 4301:         }
 4302:     }
 4303: 
 4304:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4305:             &s_objet_argument) == d_erreur)
 4306:     {
 4307:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 4308:         return;
 4309:     }
 4310: 
 4311: /*
 4312: --------------------------------------------------------------------------------
 4313:   Signe d'un entier
 4314: --------------------------------------------------------------------------------
 4315: */
 4316: 
 4317:     if ((*s_objet_argument).type == INT)
 4318:     {
 4319:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 4320:         {
 4321:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4322:             return;
 4323:         }
 4324: 
 4325:         if ((*((integer8 *) (*s_objet_argument).objet)) > 0)
 4326:         {
 4327:             (*((integer8 *) (*s_objet_resultat).objet)) = 1;
 4328:         }
 4329:         else if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
 4330:         {
 4331:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 4332:         }
 4333:         else
 4334:         {
 4335:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 4336:         }
 4337:     }
 4338: 
 4339: /*
 4340: --------------------------------------------------------------------------------
 4341:   Signe d'un réel
 4342: --------------------------------------------------------------------------------
 4343: */
 4344: 
 4345:     else if ((*s_objet_argument).type == REL)
 4346:     {
 4347:         if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
 4348:         {
 4349:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4350:             return;
 4351:         }
 4352: 
 4353:         if ((*((real8 *) (*s_objet_argument).objet)) > 0)
 4354:         {
 4355:             (*((integer8 *) (*s_objet_resultat).objet)) = 1;
 4356:         }
 4357:         else if ((*((real8 *) (*s_objet_argument).objet)) < 0)
 4358:         {
 4359:             (*((integer8 *) (*s_objet_resultat).objet)) = -1;
 4360:         }
 4361:         else
 4362:         {
 4363:             (*((integer8 *) (*s_objet_resultat).objet)) = 0;
 4364:         }
 4365:     }
 4366: 
 4367: /*
 4368: --------------------------------------------------------------------------------
 4369:   Vecteur unité dans la direction du complexe
 4370: --------------------------------------------------------------------------------
 4371: */
 4372: 
 4373:     else if ((*s_objet_argument).type == CPL)
 4374:     {
 4375:         if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
 4376:         {
 4377:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4378:             return;
 4379:         }
 4380: 
 4381:         if (((*((struct_complexe16 *) (*s_objet_argument).objet)).partie_reelle
 4382:                 != 0) || ((*((struct_complexe16 *) (*s_objet_argument).objet))
 4383:                 .partie_imaginaire != 0))
 4384:         {
 4385:             f77absc_((struct_complexe16 *) (*s_objet_argument).objet, &norme);
 4386:             f77divisioncr_((struct_complexe16 *) (*s_objet_argument).objet,
 4387:                     &norme, (struct_complexe16 *) (*s_objet_resultat).objet);
 4388:         }
 4389:         else
 4390:         {
 4391:             (*((struct_complexe16 *) (*s_objet_argument).objet))
 4392:                     .partie_reelle = 0;
 4393:             (*((struct_complexe16 *) (*s_objet_argument).objet))
 4394:                     .partie_imaginaire = 0;
 4395:         }
 4396:     }
 4397: 
 4398: /*
 4399: --------------------------------------------------------------------------------
 4400:   Signe d'un nom
 4401: --------------------------------------------------------------------------------
 4402: */
 4403: 
 4404:     else if ((*s_objet_argument).type == NOM)
 4405:     {
 4406:         if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
 4407:         {
 4408:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4409:             return;
 4410:         }
 4411: 
 4412:         if (((*s_objet_resultat).objet =
 4413:                 allocation_maillon(s_etat_processus)) == NULL)
 4414:         {
 4415:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4416:             return;
 4417:         }
 4418: 
 4419:         l_element_courant = (*s_objet_resultat).objet;
 4420: 
 4421:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 4422:                 == NULL)
 4423:         {
 4424:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4425:             return;
 4426:         }
 4427: 
 4428:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4429:                 .nombre_arguments = 0;
 4430:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4431:                 .fonction = instruction_vers_niveau_superieur;
 4432: 
 4433:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4434:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 4435:         {
 4436:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4437:             return;
 4438:         }
 4439: 
 4440:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4441:                 .nom_fonction, "<<");
 4442: 
 4443:         if (((*l_element_courant).suivant =
 4444:                 allocation_maillon(s_etat_processus)) == NULL)
 4445:         {
 4446:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4447:             return;
 4448:         }
 4449: 
 4450:         l_element_courant = (*l_element_courant).suivant;
 4451:         (*l_element_courant).donnee = s_objet_argument;
 4452: 
 4453:         if (((*l_element_courant).suivant =
 4454:                 allocation_maillon(s_etat_processus)) == NULL)
 4455:         {
 4456:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4457:             return;
 4458:         }
 4459: 
 4460:         l_element_courant = (*l_element_courant).suivant;
 4461: 
 4462:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 4463:                 == NULL)
 4464:         {
 4465:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4466:             return;
 4467:         }
 4468: 
 4469:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4470:                 .nombre_arguments = 1;
 4471:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4472:                 .fonction = instruction_sign;
 4473: 
 4474:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4475:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
 4476:         {
 4477:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4478:             return;
 4479:         }
 4480: 
 4481:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4482:                 .nom_fonction, "SIGN");
 4483: 
 4484:         if (((*l_element_courant).suivant =
 4485:                 allocation_maillon(s_etat_processus)) == NULL)
 4486:         {
 4487:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4488:             return;
 4489:         }
 4490: 
 4491:         l_element_courant = (*l_element_courant).suivant;
 4492: 
 4493:         if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
 4494:                 == NULL)
 4495:         {
 4496:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4497:             return;
 4498:         }
 4499: 
 4500:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4501:                 .nombre_arguments = 0;
 4502:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4503:                 .fonction = instruction_vers_niveau_inferieur;
 4504: 
 4505:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4506:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
 4507:         {
 4508:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4509:             return;
 4510:         }
 4511: 
 4512:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
 4513:                 .nom_fonction, ">>");
 4514: 
 4515:         (*l_element_courant).suivant = NULL;
 4516:         s_objet_argument = NULL;
 4517:     }
 4518: 
 4519: /*
 4520: --------------------------------------------------------------------------------
 4521:   Signe d'une expression
 4522: --------------------------------------------------------------------------------
 4523: */
 4524: 
 4525:     else if (((*s_objet_argument).type == ALG) ||
 4526:             ((*s_objet_argument).type == RPN))
 4527:     {
 4528:         if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
 4529:                 'N')) == NULL)
 4530:         {
 4531:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4532:             return;
 4533:         }
 4534: 
 4535:         l_element_courant = (struct_liste_chainee *)
 4536:                 (*s_copie_argument).objet;
 4537:         l_element_precedent = l_element_courant;
 4538: 
 4539:         while((*l_element_courant).suivant != NULL)
 4540:         {
 4541:             l_element_precedent = l_element_courant;
 4542:             l_element_courant = (*l_element_courant).suivant;
 4543:         }
 4544: 
 4545:         if (((*l_element_precedent).suivant =
 4546:                 allocation_maillon(s_etat_processus)) == NULL)
 4547:         {
 4548:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4549:             return;
 4550:         }
 4551: 
 4552:         if (((*(*l_element_precedent).suivant).donnee =
 4553:                 allocation(s_etat_processus, FCT)) == NULL)
 4554:         {
 4555:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4556:             return;
 4557:         }
 4558: 
 4559:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 4560:                 .donnee).objet)).nombre_arguments = 1;
 4561:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
 4562:                 .donnee).objet)).fonction = instruction_sign;
 4563: 
 4564:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
 4565:                 .suivant).donnee).objet)).nom_fonction =
 4566:                 malloc(5 * sizeof(unsigned char))) == NULL)
 4567:         {
 4568:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4569:             return;
 4570:         }
 4571: 
 4572:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
 4573:                 .suivant).donnee).objet)).nom_fonction, "SIGN");
 4574: 
 4575:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
 4576: 
 4577:         s_objet_resultat = s_copie_argument;
 4578:     }
 4579: 
 4580: /*
 4581: --------------------------------------------------------------------------------
 4582:   Fonction signe impossible à réaliser
 4583: --------------------------------------------------------------------------------
 4584: */
 4585: 
 4586:     else
 4587:     {
 4588:         liberation(s_etat_processus, s_objet_argument);
 4589: 
 4590:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 4591:         return;
 4592:     }
 4593: 
 4594:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4595:             s_objet_resultat) == d_erreur)
 4596:     {
 4597:         return;
 4598:     }
 4599: 
 4600:     liberation(s_etat_processus, s_objet_argument);
 4601: 
 4602:     return;
 4603: }
 4604: 
 4605: 
 4606: /*
 4607: ================================================================================
 4608:   Fonction 'select'
 4609: ================================================================================
 4610:   Entrées : pointeur sur une struct_processus
 4611: --------------------------------------------------------------------------------
 4612:   Sorties :
 4613: --------------------------------------------------------------------------------
 4614:   Effets de bord : néant
 4615: ================================================================================
 4616: */
 4617: 
 4618: void
 4619: instruction_select(struct_processus *s_etat_processus)
 4620: {
 4621:     (*s_etat_processus).erreur_execution = d_ex;
 4622: 
 4623:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4624:     {
 4625:         printf("\n  SELECT ");
 4626: 
 4627:         if ((*s_etat_processus).langue == 'F')
 4628:         {
 4629:             printf("(structure de contrôle)\n\n");
 4630:             printf("  Utilisation :\n\n");
 4631:         }
 4632:         else
 4633:         {
 4634:             printf("(control statement)\n\n");
 4635:             printf("  Usage:\n\n");
 4636:         }
 4637: 
 4638:         printf("    SELECT (expression test)\n");
 4639:         printf("        CASE (clause 1) THEN (expression 1) END\n");
 4640:         printf("        CASE (clause 2) THEN (expression 2) END\n");
 4641:         printf("        ...\n");
 4642:         printf("        CASE (clause n) THEN (expression n) END\n");
 4643:         printf("    DEFAULT\n");
 4644:         printf("        (expression)\n");
 4645:         printf("    END\n\n");
 4646: 
 4647:         printf("    SELECT (expression test)\n");
 4648:         printf("        CASE (clause 1) THEN (expression 1) END\n");
 4649:         printf("        (expression)\n");
 4650:         printf("        CASE (clause 2) THEN (expression 2) END\n");
 4651:         printf("    END\n");
 4652: 
 4653:         return;
 4654:     }
 4655:     else if ((*s_etat_processus).test_instruction == 'Y')
 4656:     {
 4657:         (*s_etat_processus).nombre_arguments = -1;
 4658:         return;
 4659:     }
 4660: 
 4661:     empilement_pile_systeme(s_etat_processus);
 4662: 
 4663:     if ((*s_etat_processus).erreur_systeme != d_es)
 4664:     {
 4665:         return;
 4666:     }
 4667: 
 4668:     (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'C';
 4669:     (*(*s_etat_processus).l_base_pile_systeme).clause = 'S';
 4670: 
 4671:     return;
 4672: }
 4673: 
 4674: 
 4675: /*
 4676: ================================================================================
 4677:   Fonction 'std'
 4678: ================================================================================
 4679:   Entrées : pointeur sur une struct_processus
 4680: --------------------------------------------------------------------------------
 4681:   Sorties :
 4682: --------------------------------------------------------------------------------
 4683:   Effets de bord : néant
 4684: ================================================================================
 4685: */
 4686: 
 4687: void
 4688: instruction_std(struct_processus *s_etat_processus)
 4689: {
 4690:     (*s_etat_processus).erreur_execution = d_ex;
 4691: 
 4692:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4693:     {
 4694:         printf("\n  STD ");
 4695: 
 4696:         if ((*s_etat_processus).langue == 'F')
 4697:         {
 4698:             printf("(format standard)\n\n");
 4699:             printf("  Aucun argument\n");
 4700:         }
 4701:         else
 4702:         {
 4703:             printf("(standard format)\n\n");
 4704:             printf("  No argument\n");
 4705:         }
 4706: 
 4707:         return;
 4708:     }
 4709:     else if ((*s_etat_processus).test_instruction == 'Y')
 4710:     {
 4711:         (*s_etat_processus).nombre_arguments = -1;
 4712:         return;
 4713:     }
 4714: 
 4715:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 4716:     {
 4717:         if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
 4718:         {
 4719:             return;
 4720:         }
 4721:     }
 4722: 
 4723:     cf(s_etat_processus, 49);
 4724:     cf(s_etat_processus, 50);
 4725: 
 4726:     return;
 4727: }
 4728: 
 4729: 
 4730: /*
 4731: ================================================================================
 4732:   Fonction 'sci'
 4733: ================================================================================
 4734:   Entrées : pointeur sur une struct_processus
 4735: --------------------------------------------------------------------------------
 4736:   Sorties :
 4737: --------------------------------------------------------------------------------
 4738:   Effets de bord : néant
 4739: ================================================================================
 4740: */
 4741: 
 4742: void
 4743: instruction_sci(struct_processus *s_etat_processus)
 4744: {
 4745:     struct_objet                        *s_objet_argument;
 4746:     struct_objet                        *s_objet;
 4747: 
 4748:     logical1                            i43;
 4749:     logical1                            i44;
 4750: 
 4751:     unsigned char                       *valeur_binaire;
 4752: 
 4753:     unsigned long                       i;
 4754:     unsigned long                       j;
 4755: 
 4756:     (*s_etat_processus).erreur_execution = d_ex;
 4757: 
 4758:     if ((*s_etat_processus).affichage_arguments == 'Y')
 4759:     {
 4760:         printf("\n  SCI ");
 4761: 
 4762:         if ((*s_etat_processus).langue == 'F')
 4763:         {
 4764:             printf("(format scientifique)\n\n");
 4765:         }
 4766:         else
 4767:         {
 4768:             printf("(scientific format)\n\n");
 4769:         }
 4770: 
 4771:         printf("    1: %s\n", d_INT);
 4772: 
 4773:         return;
 4774:     }
 4775:     else if ((*s_etat_processus).test_instruction == 'Y')
 4776:     {
 4777:         (*s_etat_processus).nombre_arguments = -1;
 4778:         return;
 4779:     }
 4780: 
 4781:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
 4782:     {
 4783:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
 4784:         {
 4785:             return;
 4786:         }
 4787:     }
 4788: 
 4789:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
 4790:             &s_objet_argument) == d_erreur)
 4791:     {
 4792:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
 4793:         return;
 4794:     }
 4795: 
 4796:     if ((*s_objet_argument).type == INT)
 4797:     {
 4798:         if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
 4799:                 ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
 4800:         {
 4801:             if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
 4802:             {
 4803:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4804:                 return;
 4805:             }
 4806: 
 4807:             (*((logical8 *) (*s_objet).objet)) =
 4808:                     (*((integer8 *) (*s_objet_argument).objet));
 4809: 
 4810:             i43 = test_cfsf(s_etat_processus, 43);
 4811:             i44 = test_cfsf(s_etat_processus, 44);
 4812: 
 4813:             sf(s_etat_processus, 44);
 4814:             cf(s_etat_processus, 43);
 4815: 
 4816:             if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
 4817:                     == NULL)
 4818:             {
 4819:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
 4820:                 return;
 4821:             }
 4822: 
 4823:             if (i43 == d_vrai)
 4824:             {
 4825:                 sf(s_etat_processus, 43);
 4826:             }
 4827:             else
 4828:             {
 4829:                 cf(s_etat_processus, 43);
 4830:             }
 4831: 
 4832:             if (i44 == d_vrai)
 4833:             {
 4834:                 sf(s_etat_processus, 44);
 4835:             }
 4836:             else
 4837:             {
 4838:                 cf(s_etat_processus, 44);
 4839:             }
 4840: 
 4841:             for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
 4842:             {
 4843:                 if (valeur_binaire[i] == '0')
 4844:                 {
 4845:                     cf(s_etat_processus, j++);
 4846:                 }
 4847:                 else
 4848:                 {
 4849:                     sf(s_etat_processus, j++);
 4850:                 }
 4851:             }
 4852: 
 4853:             for(; j <= 56; cf(s_etat_processus, j++));
 4854: 
 4855:             cf(s_etat_processus, 49);
 4856:             sf(s_etat_processus, 50);
 4857: 
 4858:             free(valeur_binaire);
 4859:             liberation(s_etat_processus, s_objet);
 4860:         }
 4861:         else
 4862:         {
 4863:             liberation(s_etat_processus, s_objet_argument);
 4864: 
 4865:             (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
 4866:             return;
 4867:         }
 4868:     }
 4869:     else
 4870:     {
 4871:         liberation(s_etat_processus, s_objet_argument);
 4872: 
 4873:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
 4874:         return;
 4875:     }
 4876: 
 4877:     liberation(s_etat_processus, s_objet_argument);
 4878: 
 4879:     return;
 4880: }
 4881: 
 4882: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>