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

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.1.32
    4:   Copyright (C) 1989-2020 Dr. BERTRAND Joël
    5: 
    6:   This file is part of RPL/2.
    7: 
    8:   RPL/2 is free software; you can redistribute it and/or modify it
    9:   under the terms of the CeCILL V2 License as published by the french
   10:   CEA, CNRS and INRIA.
   11:  
   12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
   13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
   15:   for more details.
   16:  
   17:   You should have received a copy of the CeCILL License
   18:   along with RPL/2. If not, write to info@cecill.info.
   19: ================================================================================
   20: */
   21: 
   22: 
   23: #include "rpl-conv.h"
   24: 
   25: 
   26: /*
   27: ================================================================================
   28:   Fonction 'array->'
   29: ================================================================================
   30:   Entrées : pointeur sur une structure struct_processus
   31: --------------------------------------------------------------------------------
   32:   Sorties :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: void
   39: instruction_array_fleche(struct_processus *s_etat_processus)
   40: {
   41:     integer8                        i;
   42:     integer8                        j;
   43: 
   44:     struct_liste_chainee            *l_element_courant;
   45: 
   46:     struct_objet                    *s_objet_source;
   47:     struct_objet                    *s_objet_elementaire;
   48: 
   49:     (*s_etat_processus).erreur_execution = d_ex;
   50: 
   51:     if ((*s_etat_processus).affichage_arguments == 'Y')
   52:     {
   53:         printf("\n  ARRAY-> [ARRY->] ");
   54: 
   55:         if ((*s_etat_processus).langue == 'F')
   56:         {
   57:             printf("(éclatement de vecteur ou de matrice)\n\n");
   58:         }
   59:         else
   60:         {
   61:             printf("(vector or matrix split)\n\n");
   62:         }
   63: 
   64:         printf("    1: %s\n", d_VIN);
   65:         printf("->  n: %s\n", d_INT);
   66:         printf("    ...\n");
   67:         printf("    1: %s\n\n", d_INT);
   68: 
   69:         printf("    1: %s\n", d_VRL);
   70:         printf("->  n: %s\n", d_REL);
   71:         printf("    ...\n");
   72:         printf("    1: %s\n\n", d_REL);
   73: 
   74:         printf("    1: %s\n", d_VCX);
   75:         printf("->  n: %s\n", d_CPL);
   76:         printf("    ...\n");
   77:         printf("    1: %s\n\n", d_CPL);
   78: 
   79:         printf("    1: %s\n", d_MIN);
   80:         printf("-> nm: %s\n", d_INT);
   81:         printf("    ...\n");
   82:         printf("    1: %s\n\n", d_INT);
   83: 
   84:         printf("    1: %s\n", d_MRL);
   85:         printf("-> nm: %s\n", d_REL);
   86:         printf("    ...\n");
   87:         printf("    1: %s\n\n", d_REL);
   88: 
   89:         printf("    1: %s\n", d_MCX);
   90:         printf("-> nm: %s\n", d_CPL);
   91:         printf("    ...\n");
   92:         printf("    1: %s\n", d_CPL);
   93: 
   94:         return;
   95:     }
   96:     else if ((*s_etat_processus).test_instruction == 'Y')
   97:     {
   98:         (*s_etat_processus).nombre_arguments = -1;
   99:         return;
  100:     }
  101: 
  102:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  103:     {
  104:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  105:         {
  106:             return;
  107:         }
  108:     }
  109: 
  110:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  111:             &s_objet_source) == d_erreur)
  112:     {
  113:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  114:         return;
  115:     }
  116: 
  117: /*
  118: --------------------------------------------------------------------------------
  119:   Cas des vecteurs
  120: --------------------------------------------------------------------------------
  121: */
  122: 
  123:     if ((*s_objet_source).type == VIN)
  124:     {
  125:         /*
  126:          * Traitement d'un vecteur d'entiers
  127:          */
  128: 
  129:         for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
  130:                 i++)
  131:         {
  132:             if ((s_objet_elementaire = allocation(s_etat_processus, INT))
  133:                     == NULL)
  134:             {
  135:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  136:                 return;
  137:             }
  138: 
  139:             (*((integer8 *) (*s_objet_elementaire).objet)) =
  140:                     ((integer8 *) (*((struct_vecteur *)
  141:                     (*s_objet_source).objet)).tableau)[i];
  142: 
  143:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  144:                     s_objet_elementaire) == d_erreur)
  145:             {
  146:                 return;
  147:             }
  148:         }
  149: 
  150:         if ((s_objet_elementaire = allocation(s_etat_processus, LST))
  151:                 == NULL)
  152:         {
  153:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  154:             return;
  155:         }
  156: 
  157:         if (((*s_objet_elementaire).objet =
  158:                 allocation_maillon(s_etat_processus)) == NULL)
  159:         {
  160:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  161:             return;
  162:         }
  163: 
  164:         l_element_courant = (struct_liste_chainee *)
  165:                 (*s_objet_elementaire).objet;
  166: 
  167:         (*l_element_courant).suivant = NULL;
  168: 
  169:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  170:                 == NULL)
  171:         {
  172:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  173:             return;
  174:         }
  175: 
  176:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  177:                 (*((struct_vecteur *) (*s_objet_source).objet)).taille;
  178:         
  179:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  180:                 s_objet_elementaire) == d_erreur)
  181:         {
  182:             return;
  183:         }
  184:     }
  185:     else if ((*s_objet_source).type == VRL)
  186:     {
  187:         /*
  188:          * Traitement d'un vecteur de réels
  189:          */
  190: 
  191:         for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
  192:                 i++)
  193:         {
  194:             if ((s_objet_elementaire = allocation(s_etat_processus, REL))
  195:                     == NULL)
  196:             {
  197:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  198:                 return;
  199:             }
  200: 
  201:             (*((real8 *) (*s_objet_elementaire).objet)) =
  202:                     ((real8 *) (*((struct_vecteur *)
  203:                     (*s_objet_source).objet)).tableau)[i];
  204: 
  205:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  206:                     s_objet_elementaire) == d_erreur)
  207:             {
  208:                 return;
  209:             }
  210:         }
  211: 
  212:         if ((s_objet_elementaire = allocation(s_etat_processus, LST))
  213:                 == NULL)
  214:         {
  215:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  216:             return;
  217:         }
  218: 
  219:         if (((*s_objet_elementaire).objet =
  220:                 allocation_maillon(s_etat_processus)) == NULL)
  221:         {
  222:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  223:             return;
  224:         }
  225: 
  226:         l_element_courant = (struct_liste_chainee *)
  227:                 (*s_objet_elementaire).objet;
  228: 
  229:         (*l_element_courant).suivant = NULL;
  230: 
  231:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  232:                 == NULL)
  233:         {
  234:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  235:             return;
  236:         }
  237: 
  238:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  239:                 (*((struct_vecteur *) (*s_objet_source).objet)).taille;
  240:         
  241:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  242:                 s_objet_elementaire) == d_erreur)
  243:         {
  244:             return;
  245:         }
  246:     }
  247:     else if ((*s_objet_source).type == VCX)
  248:     {
  249:         /*
  250:          * Traitement d'un vecteur de complexes
  251:          */
  252: 
  253:         for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
  254:                 i++)
  255:         {
  256:             if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
  257:                     == NULL)
  258:             {
  259:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  260:                 return;
  261:             }
  262: 
  263:             (*((struct_complexe16 *) (*s_objet_elementaire).objet))
  264:                     .partie_reelle = ((struct_complexe16 *)
  265:                     (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
  266:                     .partie_reelle;
  267:             (*((struct_complexe16 *) (*s_objet_elementaire).objet))
  268:                     .partie_imaginaire = ((struct_complexe16 *)
  269:                     (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
  270:                     .partie_imaginaire;
  271: 
  272:             if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  273:                     s_objet_elementaire) == d_erreur)
  274:             {
  275:                 return;
  276:             }
  277:         }
  278: 
  279:         if ((s_objet_elementaire = allocation(s_etat_processus, LST))
  280:                 == NULL)
  281:         {
  282:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  283:             return;
  284:         }
  285: 
  286:         if (((*s_objet_elementaire).objet =
  287:                 allocation_maillon(s_etat_processus)) == NULL)
  288:         {
  289:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  290:             return;
  291:         }
  292: 
  293:         l_element_courant = (struct_liste_chainee *)
  294:                 (*s_objet_elementaire).objet;
  295: 
  296:         (*l_element_courant).suivant = NULL;
  297: 
  298:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  299:                 == NULL)
  300:         {
  301:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  302:             return;
  303:         }
  304: 
  305:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  306:                 (*((struct_vecteur *) (*s_objet_source).objet)).taille;
  307:         
  308:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  309:                 s_objet_elementaire) == d_erreur)
  310:         {
  311:             return;
  312:         }
  313:     }
  314: 
  315: /*
  316: --------------------------------------------------------------------------------
  317:   Cas des matrices
  318: --------------------------------------------------------------------------------
  319: */
  320: 
  321:     else if ((*s_objet_source).type == MIN)
  322:     {
  323:         /*
  324:          * Traitement d'une matrice d'entiers
  325:          */
  326: 
  327:         for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
  328:                 .nombre_lignes; i++)
  329:         {
  330:             for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
  331:                     .nombre_colonnes; j++)
  332:             {
  333:                 if ((s_objet_elementaire = allocation(s_etat_processus, INT))
  334:                         == NULL)
  335:                 {
  336:                     (*s_etat_processus).erreur_systeme =
  337:                             d_es_allocation_memoire;
  338:                     return;
  339:                 }
  340: 
  341:                 (*((integer8 *) (*s_objet_elementaire).objet)) =
  342:                         ((integer8 **) (*((struct_matrice *)
  343:                         (*s_objet_source).objet)).tableau)[i][j];
  344: 
  345:                 if (empilement(s_etat_processus, &((*s_etat_processus)
  346:                         .l_base_pile), s_objet_elementaire) == d_erreur)
  347:                 {
  348:                     return;
  349:                 }
  350:             }
  351:         }
  352: 
  353:         if ((s_objet_elementaire = allocation(s_etat_processus, LST))
  354:                 == NULL)
  355:         {
  356:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  357:             return;
  358:         }
  359: 
  360:         if (((*s_objet_elementaire).objet =
  361:                 allocation_maillon(s_etat_processus)) == NULL)
  362:         {
  363:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  364:             return;
  365:         }
  366: 
  367:         l_element_courant = (struct_liste_chainee *)
  368:                 (*s_objet_elementaire).objet;
  369: 
  370:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  371:                 == NULL)
  372:         {
  373:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  374:             return;
  375:         }
  376: 
  377:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  378:                 (*((struct_matrice *) (*s_objet_source).objet))
  379:                 .nombre_lignes;
  380:         
  381:         if (((*l_element_courant).suivant =
  382:                 allocation_maillon(s_etat_processus)) == NULL)
  383:         {
  384:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  385:             return;
  386:         }
  387: 
  388:         l_element_courant = (*l_element_courant).suivant;
  389:         (*l_element_courant).suivant = NULL;
  390: 
  391:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  392:                 == NULL)
  393:         {
  394:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  395:             return;
  396:         }
  397: 
  398:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  399:                 (*((struct_matrice *) (*s_objet_source).objet))
  400:                 .nombre_colonnes;
  401: 
  402:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  403:                 s_objet_elementaire) == d_erreur)
  404:         {
  405:             return;
  406:         }
  407:     }
  408:     else if ((*s_objet_source).type == MRL)
  409:     {
  410:         /*
  411:          * Traitement d'une matrice de réels
  412:          */
  413: 
  414:         for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
  415:                 .nombre_lignes; i++)
  416:         {
  417:             for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
  418:                     .nombre_colonnes; j++)
  419:             {
  420:                 if ((s_objet_elementaire = allocation(s_etat_processus, REL))
  421:                         == NULL)
  422:                 {
  423:                     (*s_etat_processus).erreur_systeme =
  424:                             d_es_allocation_memoire;
  425:                     return;
  426:                 }
  427: 
  428:                 (*((real8 *) (*s_objet_elementaire).objet)) =
  429:                         ((real8 **) (*((struct_matrice *)
  430:                         (*s_objet_source).objet)).tableau)[i][j];
  431: 
  432:                 if (empilement(s_etat_processus, &((*s_etat_processus)
  433:                         .l_base_pile), s_objet_elementaire) == d_erreur)
  434:                 {
  435:                     return;
  436:                 }
  437:             }
  438:         }
  439: 
  440:         if ((s_objet_elementaire = allocation(s_etat_processus, LST))
  441:                 == NULL)
  442:         {
  443:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  444:             return;
  445:         }
  446: 
  447:         if (((*s_objet_elementaire).objet =
  448:                 allocation_maillon(s_etat_processus)) == NULL)
  449:         {
  450:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  451:             return;
  452:         }
  453: 
  454:         l_element_courant = (struct_liste_chainee *)
  455:                 (*s_objet_elementaire).objet;
  456: 
  457:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  458:                 == NULL)
  459:         {
  460:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  461:             return;
  462:         }
  463: 
  464:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  465:                 (*((struct_matrice *) (*s_objet_source).objet))
  466:                 .nombre_lignes;
  467:         
  468:         if (((*l_element_courant).suivant =
  469:                 allocation_maillon(s_etat_processus)) == NULL)
  470:         {
  471:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  472:             return;
  473:         }
  474: 
  475:         l_element_courant = (*l_element_courant).suivant;
  476:         (*l_element_courant).suivant = NULL;
  477: 
  478:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  479:                 == NULL)
  480:         {
  481:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  482:             return;
  483:         }
  484: 
  485:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  486:                 (*((struct_matrice *) (*s_objet_source).objet))
  487:                 .nombre_colonnes;
  488: 
  489:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  490:                 s_objet_elementaire) == d_erreur)
  491:         {
  492:             return;
  493:         }
  494:     }
  495:     else if ((*s_objet_source).type == MCX)
  496:     {
  497:         /*
  498:          * Traitement d'une matrice de complexes
  499:          */
  500: 
  501:         for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
  502:                 .nombre_lignes; i++)
  503:         {
  504:             for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
  505:                     .nombre_colonnes; j++)
  506:             {
  507:                 if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
  508:                         == NULL)
  509:                 {
  510:                     (*s_etat_processus).erreur_systeme =
  511:                             d_es_allocation_memoire;
  512:                     return;
  513:                 }
  514: 
  515:                 (*((struct_complexe16 *) (*s_objet_elementaire).objet))
  516:                         .partie_reelle = ((struct_complexe16 **)
  517:                         (*((struct_matrice *) (*s_objet_source).objet))
  518:                         .tableau)[i][j].partie_reelle;
  519:                 (*((struct_complexe16 *) (*s_objet_elementaire).objet))
  520:                         .partie_imaginaire = ((struct_complexe16 **)
  521:                         (*((struct_matrice *) (*s_objet_source).objet))
  522:                         .tableau)[i][j].partie_imaginaire;
  523: 
  524:                 if (empilement(s_etat_processus, &((*s_etat_processus)
  525:                         .l_base_pile), s_objet_elementaire) == d_erreur)
  526:                 {
  527:                     return;
  528:                 }
  529:             }
  530:         }
  531: 
  532:         if ((s_objet_elementaire = allocation(s_etat_processus, LST))
  533:                 == NULL)
  534:         {
  535:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  536:             return;
  537:         }
  538: 
  539:         if (((*s_objet_elementaire).objet =
  540:                 allocation_maillon(s_etat_processus)) == NULL)
  541:         {
  542:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  543:             return;
  544:         }
  545: 
  546:         l_element_courant = (struct_liste_chainee *)
  547:                 (*s_objet_elementaire).objet;
  548: 
  549:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  550:                 == NULL)
  551:         {
  552:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  553:             return;
  554:         }
  555: 
  556:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  557:                 (*((struct_matrice *) (*s_objet_source).objet))
  558:                 .nombre_lignes;
  559:         
  560:         if (((*l_element_courant).suivant =
  561:                 allocation_maillon(s_etat_processus)) == NULL)
  562:         {
  563:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  564:             return;
  565:         }
  566: 
  567:         l_element_courant = (*l_element_courant).suivant;
  568:         (*l_element_courant).suivant = NULL;
  569: 
  570:         if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
  571:                 == NULL)
  572:         {
  573:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  574:             return;
  575:         }
  576: 
  577:         (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
  578:                 (*((struct_matrice *) (*s_objet_source).objet))
  579:                 .nombre_colonnes;
  580: 
  581:         if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  582:                 s_objet_elementaire) == d_erreur)
  583:         {
  584:             return;
  585:         }
  586:     }
  587: 
  588: /*
  589: --------------------------------------------------------------------------------
  590:   Réalisation impossible de la fonction ARRAY->
  591: --------------------------------------------------------------------------------
  592: */
  593: 
  594:     else
  595:     {
  596:         liberation(s_etat_processus, s_objet_source);
  597: 
  598:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  599:         return;
  600:     }
  601: 
  602:     liberation(s_etat_processus, s_objet_source);
  603: 
  604:     return;
  605: }
  606: 
  607: 
  608: /*
  609: ================================================================================
  610:   Fonction 'alog'
  611: ================================================================================
  612:   Entrées : pointeur sur une struct_processus
  613: --------------------------------------------------------------------------------
  614:   Sorties :
  615: --------------------------------------------------------------------------------
  616:   Effets de bord : néant
  617: ================================================================================
  618: */
  619: 
  620: void
  621: instruction_alog(struct_processus *s_etat_processus)
  622: {
  623:     integer8                        base;
  624:     integer8                        tampon;
  625: 
  626:     struct_liste_chainee            *l_element_courant;
  627:     struct_liste_chainee            *l_element_precedent;
  628: 
  629:     struct_objet                    *s_copie_argument;
  630:     struct_objet                    *s_objet_argument;
  631:     struct_objet                    *s_objet_resultat;
  632: 
  633:     (*s_etat_processus).erreur_execution = d_ex;
  634: 
  635:     if ((*s_etat_processus).affichage_arguments == 'Y')
  636:     {
  637:         printf("\n  ALOG ");
  638: 
  639:         if ((*s_etat_processus).langue == 'F')
  640:         {
  641:             printf("(antilogarithme base 10)\n\n");
  642:         }
  643:         else
  644:         {
  645:             printf("(10-based antilogarithm)\n\n");
  646:         }
  647: 
  648:         printf("    1: %s\n", d_INT);
  649:         printf("->  1: %s, %s\n\n", d_INT, d_REL);
  650: 
  651:         printf("    1: %s\n", d_REL);
  652:         printf("->  1: %s\n", d_REL);
  653: 
  654:         printf("    1: %s\n", d_CPL);
  655:         printf("->  1: %s\n", d_CPL);
  656: 
  657:         printf("    1: %s, %s\n", d_NOM, d_ALG);
  658:         printf("->  1: %s\n\n", d_ALG);
  659: 
  660:         printf("    1: %s\n", d_RPN);
  661:         printf("->  1: %s\n", d_RPN);
  662: 
  663:         return;
  664:     }
  665:     else if ((*s_etat_processus).test_instruction == 'Y')
  666:     {
  667:         (*s_etat_processus).nombre_arguments = 1;
  668:         return;
  669:     }
  670: 
  671:     if (test_cfsf(s_etat_processus, 31) == d_vrai)
  672:     {
  673:         if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
  674:         {
  675:             return;
  676:         }
  677:     }
  678: 
  679:     if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  680:             &s_objet_argument) == d_erreur)
  681:     {
  682:         (*s_etat_processus).erreur_execution = d_ex_manque_argument;
  683:         return;
  684:     }
  685: 
  686: /*
  687: --------------------------------------------------------------------------------
  688:   Alog d'un entier
  689: --------------------------------------------------------------------------------
  690: */
  691: 
  692:     if ((*s_objet_argument).type == INT)
  693:     {
  694:         base = 10;
  695: 
  696:         if (depassement_puissance(&base, (integer8 *) (*s_objet_argument).objet,
  697:                 &tampon) == d_absence_erreur)
  698:         {
  699:             if ((s_objet_resultat = allocation(s_etat_processus, INT))
  700:                     == NULL)
  701:             {
  702:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  703:                 return;
  704:             }
  705: 
  706:             (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
  707:         }
  708:         else
  709:         {
  710:             if ((s_objet_resultat = allocation(s_etat_processus, REL))
  711:                     == NULL)
  712:             {
  713:                 (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  714:                 return;
  715:             }
  716: 
  717:             (*((real8 *) (*s_objet_resultat).objet)) =
  718:                     pow((real8) 10, (real8) (*((integer8 *)
  719:                     (*s_objet_argument).objet)));
  720:         }
  721:     }
  722: 
  723: /*
  724: --------------------------------------------------------------------------------
  725:   Alog d'un réel
  726: --------------------------------------------------------------------------------
  727: */
  728: 
  729:     else if ((*s_objet_argument).type == REL)
  730:     {
  731:         if ((s_objet_resultat = allocation(s_etat_processus, REL))
  732:                 == NULL)
  733:         {
  734:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  735:             return;
  736:         }
  737: 
  738:         (*((real8 *) (*s_objet_resultat).objet)) =
  739:                 pow((real8) 10, ((*((real8 *) (*s_objet_argument).objet))));
  740:     }
  741: 
  742: /*
  743: --------------------------------------------------------------------------------
  744:   Alog d'un complexe
  745: --------------------------------------------------------------------------------
  746: */
  747: 
  748:     else if ((*s_objet_argument).type == CPL)
  749:     {
  750:         if ((s_objet_resultat = allocation(s_etat_processus, CPL))
  751:                 == NULL)
  752:         {
  753:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  754:             return;
  755:         }
  756: 
  757:         f77alogc_(&((*((struct_complexe16 *) (*s_objet_argument).objet))),
  758:                 (struct_complexe16 *) (*s_objet_resultat).objet);
  759:     }
  760: 
  761: /*
  762: --------------------------------------------------------------------------------
  763:   Alog d'un nom
  764: --------------------------------------------------------------------------------
  765: */
  766: 
  767:     else if ((*s_objet_argument).type == NOM)
  768:     {
  769:         if ((s_objet_resultat = allocation(s_etat_processus, ALG))
  770:                 == NULL)
  771:         {
  772:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  773:             return;
  774:         }
  775: 
  776:         if (((*s_objet_resultat).objet =
  777:                 allocation_maillon(s_etat_processus)) == NULL)
  778:         {
  779:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  780:             return;
  781:         }
  782: 
  783:         l_element_courant = (*s_objet_resultat).objet;
  784: 
  785:         if (((*l_element_courant).donnee =
  786:                 allocation(s_etat_processus, FCT)) == NULL)
  787:         {
  788:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  789:             return;
  790:         }
  791: 
  792:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  793:                 .nombre_arguments = 0;
  794:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  795:                 .fonction = instruction_alog;
  796: 
  797:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  798:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  799:         {
  800:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  801:             return;
  802:         }
  803: 
  804:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  805:                 .nom_fonction, "<<");
  806: 
  807:         if (((*l_element_courant).suivant =
  808:                 allocation_maillon(s_etat_processus)) == NULL)
  809:         {
  810:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  811:             return;
  812:         }
  813: 
  814:         l_element_courant = (*l_element_courant).suivant;
  815:         (*l_element_courant).donnee = s_objet_argument;
  816: 
  817:         if (((*l_element_courant).suivant =
  818:                 allocation_maillon(s_etat_processus)) == NULL)
  819:         {
  820:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  821:             return;
  822:         }
  823: 
  824:         l_element_courant = (*l_element_courant).suivant;
  825: 
  826:         if (((*l_element_courant).donnee =
  827:                 allocation(s_etat_processus, FCT)) == NULL)
  828:         {
  829:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  830:             return;
  831:         }
  832: 
  833:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  834:                 .nombre_arguments = 1;
  835:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  836:                 .fonction = instruction_alog;
  837: 
  838:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  839:                 .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
  840:         {
  841:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  842:             return;
  843:         }
  844:             
  845:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  846:                 .nom_fonction, "ALOG");
  847: 
  848:         if (((*l_element_courant).suivant =
  849:                 allocation_maillon(s_etat_processus)) == NULL)
  850:         {
  851:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  852:             return;
  853:         }
  854: 
  855:         l_element_courant = (*l_element_courant).suivant;
  856: 
  857:         if (((*l_element_courant).donnee =
  858:                 allocation(s_etat_processus, FCT)) == NULL)
  859:         {
  860:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  861:             return;
  862:         }
  863: 
  864:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  865:                 .nombre_arguments = 0;
  866:         (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  867:                 .fonction = instruction_vers_niveau_inferieur;
  868: 
  869:         if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  870:                 .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
  871:         {
  872:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  873:             return;
  874:         }
  875: 
  876:         strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
  877:                 .nom_fonction, ">>");
  878: 
  879:         (*l_element_courant).suivant = NULL;
  880:         s_objet_argument = NULL;
  881:     }
  882: 
  883: /*
  884: --------------------------------------------------------------------------------
  885:   Alog d'une expression
  886: --------------------------------------------------------------------------------
  887: */
  888: 
  889:     else if (((*s_objet_argument).type == ALG) ||
  890:             ((*s_objet_argument).type == RPN))
  891:     {
  892:         if ((s_copie_argument = copie_objet(s_etat_processus,
  893:                 s_objet_argument, 'N')) == NULL)
  894:         {
  895:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  896:             return;
  897:         }
  898: 
  899:         l_element_courant = (struct_liste_chainee *)
  900:                 (*s_copie_argument).objet;
  901:         l_element_precedent = l_element_courant;
  902: 
  903:         while((*l_element_courant).suivant != NULL)
  904:         {
  905:             l_element_precedent = l_element_courant;
  906:             l_element_courant = (*l_element_courant).suivant;
  907:         }
  908: 
  909:         if (((*l_element_precedent).suivant =
  910:                 allocation_maillon(s_etat_processus)) == NULL)
  911:         {
  912:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  913:             return;
  914:         }
  915: 
  916:         if (((*(*l_element_precedent).suivant).donnee =
  917:                 allocation(s_etat_processus, FCT)) == NULL)
  918:         {
  919:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  920:             return;
  921:         }
  922: 
  923:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  924:                 .donnee).objet)).nombre_arguments = 1;
  925:         (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
  926:                 .donnee).objet)).fonction = instruction_alog;
  927: 
  928:         if (((*((struct_fonction *) (*(*(*l_element_precedent)
  929:                 .suivant).donnee).objet)).nom_fonction =
  930:                 malloc(5 * sizeof(unsigned char))) == NULL)
  931:         {
  932:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  933:             return;
  934:         }
  935: 
  936:         strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
  937:                 .suivant).donnee).objet)).nom_fonction, "ALOG");
  938: 
  939:         (*(*l_element_precedent).suivant).suivant = l_element_courant;
  940: 
  941:         s_objet_resultat = s_copie_argument;
  942:     }
  943: 
  944: /*
  945: --------------------------------------------------------------------------------
  946:   Fonction alog impossible à réaliser
  947: --------------------------------------------------------------------------------
  948: */
  949: 
  950:     else
  951:     {
  952:         liberation(s_etat_processus, s_objet_argument);
  953: 
  954:         (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
  955:         return;
  956:     }
  957: 
  958:     liberation(s_etat_processus, s_objet_argument);
  959: 
  960:     if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
  961:             s_objet_resultat) == d_erreur)
  962:     {
  963:         return;
  964:     }
  965: 
  966:     return;
  967: }
  968: 
  969: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>