File:  [local] / rpl / src / gestion_pile_systeme.c
Revision 1.87: 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:   Procédure d'estimation de la longueur du tampon
   29: ================================================================================
   30:   Entrée :
   31: --------------------------------------------------------------------------------
   32:   Sortie :
   33: --------------------------------------------------------------------------------
   34:   Effets de bord : néant
   35: ================================================================================
   36: */
   37: 
   38: static inline void
   39: estimation_taille_pile_systeme(struct_processus *s_etat_processus)
   40: {
   41:     (*s_etat_processus).estimation_taille_pile_systeme_tampon =
   42:             (((double) (*s_etat_processus)
   43:             .estimation_taille_pile_systeme_tampon) *
   44:             ((double) 0.9)) + (((double) (*s_etat_processus)
   45:             .hauteur_pile_systeme) * ((double) 0.1));
   46:     return;
   47: }
   48: 
   49: 
   50: /*
   51: ================================================================================
   52:   Procédure d'empilement d'un nouvel élément
   53: ================================================================================
   54:   Entrée :
   55: --------------------------------------------------------------------------------
   56:   Sortie :
   57: --------------------------------------------------------------------------------
   58:   Effets de bord : néant
   59: ================================================================================
   60: */
   61: 
   62: void
   63: empilement_pile_systeme(struct_processus *s_etat_processus)
   64: {
   65:     struct_liste_pile_systeme       *l_ancienne_base_liste;
   66:     struct_liste_pile_systeme       *l_nouvelle_base_liste;
   67: 
   68:     l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;
   69: 
   70:     if ((*s_etat_processus).debug == d_vrai)
   71:         if (((*s_etat_processus).type_debug &
   72:                 d_debug_pile_systeme) != 0)
   73:     {
   74:         if (strlen((*s_etat_processus).instruction_courante) != 0)
   75:         {
   76:             if ((*s_etat_processus).langue == 'F')
   77:             {
   78:                 printf("[%d] Empilement sur la pile système à la suite de "
   79:                         "l'instruction %s\n", (int) getpid(),
   80:                         (*s_etat_processus).instruction_courante);
   81:             }
   82:             else
   83:             {
   84:                 printf("[%d] Pushing on system stack (instruction %s)\n",
   85:                         (int) getpid(),
   86:                         (*s_etat_processus).instruction_courante);
   87:             }
   88:         }
   89:         else
   90:         {
   91:             if ((*s_etat_processus).langue == 'F')
   92:             {
   93:                 printf("[%d] Empilement sur la pile système\n",
   94:                         (int) getpid());
   95:             }
   96:             else
   97:             {
   98:                 printf("[%d] Pushing on system stack\n", (int) getpid());
   99:             }
  100:         }
  101: 
  102:         fflush(stdout);
  103:     }
  104: 
  105:     if ((*s_etat_processus).pile_systeme_tampon == NULL)
  106:     {
  107:         // Tampon vide, on alloue un élément.
  108: 
  109:         if ((l_nouvelle_base_liste = malloc(sizeof(struct_liste_pile_systeme)))
  110:                 == NULL)
  111:         {
  112:             (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  113:             return;
  114:         }
  115:     }
  116:     else
  117:     {
  118:         // Tampon utilisable, on retire un élément du tampon.
  119: 
  120:         l_nouvelle_base_liste = (*s_etat_processus).pile_systeme_tampon;
  121:         (*s_etat_processus).pile_systeme_tampon =
  122:                 (*l_nouvelle_base_liste).suivant;
  123:         (*s_etat_processus).taille_pile_systeme_tampon--;
  124:     }
  125: 
  126:     (*s_etat_processus).hauteur_pile_systeme++;
  127:     (*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
  128:     (*(*s_etat_processus).l_base_pile_systeme).suivant =
  129:             l_ancienne_base_liste;
  130: 
  131:     (*(*s_etat_processus).l_base_pile_systeme).type_cloture = ' ';
  132:     (*(*s_etat_processus).l_base_pile_systeme).clause = ' ';
  133:     (*(*s_etat_processus).l_base_pile_systeme).adresse_retour = 0;
  134:     (*(*s_etat_processus).l_base_pile_systeme).niveau_courant =
  135:             (*s_etat_processus).niveau_courant;
  136:     (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N';
  137:     (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
  138:     (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = NULL;
  139:     (*(*s_etat_processus).l_base_pile_systeme).objet_de_test = NULL;
  140:     (*(*s_etat_processus).l_base_pile_systeme).nom_variable = NULL;
  141:     (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour = NULL;
  142:     (*(*s_etat_processus).l_base_pile_systeme)
  143:             .origine_routine_evaluation = 'N';
  144:     (*(*s_etat_processus).l_base_pile_systeme).arret_si_exception =
  145:             (*s_etat_processus).arret_si_exception;
  146:     (*(*s_etat_processus).l_base_pile_systeme).creation_variables_statiques
  147:             = (*s_etat_processus).creation_variables_statiques;
  148:     (*(*s_etat_processus).l_base_pile_systeme).creation_variables_partagees
  149:             = (*s_etat_processus).creation_variables_partagees;
  150:     (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression =
  151:             d_faux;
  152:     (*(*s_etat_processus).l_base_pile_systeme).debug_programme =
  153:             (*s_etat_processus).debug_programme;
  154: 
  155:     (*s_etat_processus).erreur_systeme = d_es;
  156:     (*s_etat_processus).creation_variables_statiques = d_faux;
  157:     (*s_etat_processus).creation_variables_partagees = d_faux;
  158: 
  159:     return;
  160: }
  161: 
  162: 
  163: /*
  164: ================================================================================
  165:   Procédure de dépilement d'un élément
  166: ================================================================================
  167:   Entrée :
  168: --------------------------------------------------------------------------------
  169:   Sortie :
  170: --------------------------------------------------------------------------------
  171:   Effets de bord : néant
  172: ================================================================================
  173: */
  174: 
  175: void
  176: depilement_pile_systeme(struct_processus *s_etat_processus)
  177: {
  178:     struct_liste_pile_systeme       *l_ancienne_base_liste;
  179:     struct_liste_pile_systeme       *l_nouvelle_base_liste;
  180: 
  181:     if ((*s_etat_processus).debug == d_vrai)
  182:         if (((*s_etat_processus).type_debug &
  183:                 d_debug_pile_systeme) != 0)
  184:     {
  185:         if (strlen((*s_etat_processus).instruction_courante) != 0)
  186:         {
  187:             if ((*s_etat_processus).langue == 'F')
  188:             {
  189:                 printf("[%d] Dépilement de la pile système à la suite "
  190:                         "de l'instruction %s\n", (int) getpid(),
  191:                         (*s_etat_processus).instruction_courante);
  192:             }
  193:             else
  194:             {
  195:                 printf("[%d] Pulling from system stack (instruction %s)\n",
  196:                         (int) getpid(),
  197:                         (*s_etat_processus).instruction_courante);
  198:             }
  199:         }
  200:         else
  201:         {
  202:             if ((*s_etat_processus).langue == 'F')
  203:             {
  204:                 printf("[%d] Dépilement de la pile système\n",
  205:                         (int) getpid());
  206:             }
  207:             else
  208:             {
  209:                 printf("[%d] Pulling from system stack\n", (int) getpid());
  210:             }
  211:         }
  212: 
  213:         fflush(stdout);
  214:     }
  215: 
  216:     if ((*s_etat_processus).l_base_pile_systeme == NULL)
  217:     {
  218:         (*s_etat_processus).erreur_systeme = d_es_pile_vide;
  219:     }
  220:     else
  221:     {
  222:         (*s_etat_processus).hauteur_pile_systeme--;
  223:         l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;
  224:         l_nouvelle_base_liste = (*l_ancienne_base_liste).suivant;
  225: 
  226:         (*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
  227:         (*s_etat_processus).erreur_systeme = d_es;
  228: 
  229:         // On positionne le drapeau de création des variables statiques.
  230: 
  231:         (*s_etat_processus).creation_variables_statiques =
  232:                  (*l_ancienne_base_liste).creation_variables_statiques;
  233:         (*s_etat_processus).creation_variables_partagees =
  234:                  (*l_ancienne_base_liste).creation_variables_partagees;
  235: 
  236:         if ((*l_ancienne_base_liste).nom_variable != NULL)
  237:         {
  238:             free((*l_ancienne_base_liste).nom_variable);
  239:         }
  240: 
  241:         liberation(s_etat_processus, (*l_ancienne_base_liste).indice_boucle);
  242:         liberation(s_etat_processus,
  243:                 (*l_ancienne_base_liste).limite_indice_boucle);
  244:         liberation(s_etat_processus, (*l_ancienne_base_liste).objet_de_test);
  245: 
  246:         if ((*s_etat_processus).taille_pile_systeme_tampon <= (10 *
  247:                 ((*s_etat_processus).estimation_taille_pile_systeme_tampon
  248:                 + 1)))
  249:         {
  250:             // Enregistrement de la structure pour un usage ultérieur.
  251: 
  252:             (*l_ancienne_base_liste).suivant =
  253:                     (*s_etat_processus).pile_systeme_tampon;
  254:             (*s_etat_processus).pile_systeme_tampon = l_ancienne_base_liste;
  255:             (*s_etat_processus).taille_pile_systeme_tampon++;
  256:         }
  257:         else
  258:         {
  259:             // Libération car le tampon est plein.
  260: 
  261:             free(l_ancienne_base_liste);
  262:         }
  263:     }
  264: 
  265:     return;
  266: }
  267: 
  268: 
  269: /*
  270: ================================================================================
  271:   Procédure d'effacement de la pile système
  272: ================================================================================
  273:   Entrée :
  274: --------------------------------------------------------------------------------
  275:   Sortie :
  276: --------------------------------------------------------------------------------
  277:   Effets de bord : néant
  278: ================================================================================
  279: */
  280: 
  281: void
  282: effacement_pile_systeme(struct_processus *s_etat_processus)
  283: {
  284:     while((*s_etat_processus).l_base_pile_systeme != NULL)
  285:     {
  286:         depilement_pile_systeme(s_etat_processus);
  287:     }
  288: 
  289:     return;
  290: }
  291: 
  292: 
  293: /*
  294: ================================================================================
  295:   Procédure d'affichage de la pile système
  296: ================================================================================
  297:   Entrée :
  298: --------------------------------------------------------------------------------
  299:   Sortie :
  300: --------------------------------------------------------------------------------
  301:   Effets de bord : néant
  302: ================================================================================
  303: */
  304: 
  305: void
  306: trace(struct_processus *s_etat_processus, FILE *flux)
  307: {
  308:     integer8                        i;
  309:     integer8                        j;
  310:     integer8                        candidat;
  311:     integer8                        candidat8;
  312:     integer8                        delta;
  313:     integer8                        nb_variables;
  314: 
  315:     struct_liste_chainee            *l_element_expression;
  316: 
  317:     struct_liste_pile_systeme       *l_element_courant;
  318: 
  319:     struct_tableau_variables        *tableau;
  320: 
  321:     unsigned char                   *tampon;
  322: 
  323:     l_element_courant = (*s_etat_processus).l_base_pile_systeme;
  324:     i = 0;
  325: 
  326:     while(l_element_courant != NULL)
  327:     {
  328:         i++;
  329:         l_element_courant = (*l_element_courant).suivant;
  330:     }
  331: 
  332:     l_element_courant = (*s_etat_processus).l_base_pile_systeme;
  333:     flockfile(flux);
  334: 
  335:     nb_variables = nombre_variables(s_etat_processus);
  336: 
  337:     if ((tableau = malloc(((size_t) nb_variables) *
  338:             sizeof(struct_tableau_variables))) == NULL)
  339:     {
  340:         (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
  341:         return;
  342:     }
  343: 
  344:     liste_variables(s_etat_processus, tableau);
  345: 
  346:     if ((flux == stderr) || (flux == stdout))
  347:     {
  348:         fprintf(flux, "+++Backtrace\n");
  349:     }
  350: 
  351:     while(l_element_courant != NULL)
  352:     {
  353:         fprintf(flux, "%lld : address # %016Xh\n", i--, l_element_courant);
  354: 
  355:         if ((*l_element_courant).creation_variables_statiques == d_vrai)
  356:         {
  357:             fprintf(flux, "    Variables         = static\n");
  358:         }
  359:         else if ((*l_element_courant).creation_variables_partagees == d_vrai)
  360:         {
  361:             fprintf(flux, "    Variables         = shared\n");
  362:         }
  363:         else
  364:         {
  365:             fprintf(flux, "    Variables         = automatic\n");
  366:         }
  367: 
  368:         if ((*l_element_courant).arret_si_exception == d_vrai)
  369:         {
  370:             fprintf(flux, "    In exception      = abort\n");
  371:         }
  372:         else
  373:         {
  374:             fprintf(flux, "    In exception      = catch\n");
  375:         }
  376: 
  377:         if ((*l_element_courant).clause != ' ')
  378:         {
  379:             fprintf(flux, "    Structure         = ");
  380: 
  381:             switch((*l_element_courant).clause)
  382:             {
  383:                 case 'I':
  384:                     fprintf(flux, "IF\n");
  385:                     break;
  386: 
  387:                 case 'R':
  388:                     fprintf(flux, "IFERR\n");
  389:                     break;
  390: 
  391:                 case 'X':
  392:                     fprintf(flux, "exception caught by IFERR\n");
  393:                     break;
  394: 
  395:                 case 'T':
  396:                     fprintf(flux, "THEN\n");
  397:                     break;
  398:                 
  399:                 case 'E':
  400:                     fprintf(flux, "ELSE\n");
  401:                     break;
  402: 
  403:                 case 'Z':
  404:                     fprintf(flux, "ELSE (false condition)\n");
  405:                     break;
  406: 
  407:                 case 'D':
  408:                     fprintf(flux, "DO\n");
  409:                     break;
  410: 
  411:                 case 'U':
  412:                     fprintf(flux, "UNTIL\n");
  413:                     break;
  414: 
  415:                 case 'W':
  416:                     fprintf(flux, "WHILE\n");
  417:                     break;
  418: 
  419:                 case 'M':
  420:                     fprintf(flux, "WHILE (false condition)\n");
  421:                     break;
  422: 
  423:                 case 'S':
  424:                     fprintf(flux, "SELECT\n");
  425:                     break;
  426: 
  427:                 case 'K':
  428:                     fprintf(flux, "CASE (no true condition)\n");
  429:                     break;
  430: 
  431:                 case 'C':
  432:                     fprintf(flux, "CASE (one or more true conditions)\n");
  433:                     break;
  434: 
  435:                 case 'Q':
  436:                     fprintf(flux, "CASE (treatment of a true condition)\n");
  437:                     break;
  438: 
  439:                 case 'F':
  440:                     fprintf(flux, "CASE (treatment of default case)\n");
  441:                     break;
  442:             }
  443:         }
  444: 
  445:         if ((*l_element_courant).type_cloture != ' ')
  446:         {
  447:             fprintf(flux, "    Next close        = ");
  448: 
  449:             switch((*l_element_courant).type_cloture)
  450:             {
  451:                 case 'C':
  452:                     fprintf(flux, "SELECT\n");
  453:                     break;
  454: 
  455:                 case 'D':
  456:                     fprintf(flux, "DO\n");
  457:                     break;
  458: 
  459:                 case 'I':
  460:                     fprintf(flux, "IF\n");
  461:                     break;
  462: 
  463:                 case 'J':
  464:                     fprintf(flux, "IFERR\n");
  465:                     break;
  466: 
  467:                 case 'K':
  468:                     fprintf(flux, "CASE\n");
  469:                     break;
  470: 
  471:                 case 'W':
  472:                     fprintf(flux, "WHILE\n");
  473:                     break;
  474: 
  475:                 case 'Q':
  476:                     fprintf(flux, "CRITICAL\n");
  477:                     break;
  478: 
  479:                 case 'F':
  480:                     fprintf(flux, "FOR\n");
  481:                     break;
  482: 
  483:                 case 'S':
  484:                     fprintf(flux, "START\n");
  485:                     break;
  486: 
  487:                 case 'L':
  488:                     fprintf(flux, "internal loop\n");
  489:                     break;
  490: 
  491:                 case 'A':
  492:                     fprintf(flux, "FORALL\n");
  493:                     break;
  494:             }
  495:         }
  496: 
  497:         fprintf(flux, "    Level             = %lld\n",
  498:                 (long long int) (*l_element_courant).niveau_courant);
  499: 
  500:         if ((*l_element_courant).retour_definition == 'Y')
  501:         {
  502:             fprintf(flux, "    Return            = yes\n");
  503: 
  504:             if ((*l_element_courant).origine_routine_evaluation == 'Y')
  505:             {
  506:                 if ((*l_element_courant).pointeur_objet_retour != NULL)
  507:                 {
  508:                     fprintf(flux, "    Come from         = compiled code ");
  509:                     fprintf(flux, "(address # %016Xh)\n", (*l_element_courant)
  510:                             .pointeur_objet_retour);
  511: 
  512:                     // Calcul de la routine de départ
  513: 
  514:                     candidat = -1;
  515: 
  516:                     for(j = 0; j < nb_variables; j++)
  517:                     {
  518:                         if (tableau[j].objet != NULL)
  519:                         {
  520:                             // Variable ni partagée ni statique
  521:                             if (((*(tableau[j].objet)).type == RPN) ||
  522:                                     ((*(tableau[j].objet)).type == ALG))
  523:                             {
  524:                                 l_element_expression =
  525:                                         (*(tableau[j].objet)).objet;
  526: 
  527:                                 while(l_element_expression != NULL)
  528:                                 {
  529:                                     if (l_element_expression ==
  530:                                             (*l_element_courant)
  531:                                             .pointeur_objet_retour)
  532:                                     {
  533:                                         candidat = j;
  534:                                         break;
  535:                                     }
  536: 
  537:                                     l_element_expression =
  538:                                             (*l_element_expression).suivant;
  539:                                 }
  540: 
  541:                                 if (candidat != -1)
  542:                                 {
  543:                                     break;
  544:                                 }
  545:                             }
  546:                         }
  547:                     }
  548: 
  549:                     if (candidat != -1)
  550:                     {
  551:                         fprintf(flux, "                      = %s [",
  552:                                 tableau[candidat].nom);
  553:                        
  554:                         if ((*(tableau[candidat].objet)).type == RPN)
  555:                         {
  556:                             fprintf(flux, "definition");
  557:                         }
  558:                         else if ((*(tableau[candidat].objet)).type == ALG)
  559:                         {
  560:                             fprintf(flux, "algebraic");
  561:                         }
  562:                         else if ((*(tableau[candidat].objet)).type == NOM)
  563:                         {
  564:                             fprintf(flux, "name");
  565:                         }
  566:                         else
  567:                         {
  568:                             fprintf(flux, "unknown");
  569:                         }
  570: 
  571:                         fprintf(flux, "]\n");
  572:                     }
  573:                     else
  574:                     {
  575:                         fprintf(flux, "                      = "
  576:                                 "optimized definition\n");
  577:                     }
  578:                 }
  579:                 else
  580:                 {
  581:                     fprintf(flux, "    Come from         = compiled code\n");
  582:                     fprintf(flux, "                      = "
  583:                             "optimized definition\n");
  584:                 }
  585:             }
  586:             else
  587:             {
  588:                 fprintf(flux, "    Come from         = interpreted code ");
  589: 
  590:                 if ((*l_element_courant).adresse_retour != 0)
  591:                 {
  592:                     fprintf(flux, "(offset # %016Xh)\n", (*l_element_courant)
  593:                             .adresse_retour);
  594: 
  595:                     // Calcul de la routine de départ
  596: 
  597:                     candidat8 = (*s_etat_processus)
  598:                             .longueur_definitions_chainees;
  599:                     candidat = -1;
  600: 
  601:                     for(j = 0; j < nb_variables; j++)
  602:                     {
  603:                         if ((*(tableau[j].objet)).type == ADR)
  604:                         {
  605:                             delta = (*l_element_courant).adresse_retour
  606:                                     - (*((integer8 *)
  607:                                     (*(tableau[j].objet)).objet));
  608: 
  609:                             if ((delta >= 0) && (delta < candidat8))
  610:                             {
  611:                                 candidat8 = delta;
  612:                                 candidat = j;
  613:                             }
  614:                         }
  615:                     }
  616: 
  617:                     if (candidat != -1)
  618:                     {
  619:                         fprintf(flux, "                      = %s\n",
  620:                                 tableau[candidat].nom);
  621:                     }
  622:                     else
  623:                     {
  624:                         fprintf(flux, "                      = "
  625:                                 "unknown definition\n");
  626:                     }
  627:                 }
  628:                 else if ((*l_element_courant).niveau_courant == 0)
  629:                 {
  630:                     fprintf(flux, "\n");
  631:                     fprintf(flux, "                      = RPL/2 "
  632:                             "initialization\n");
  633:                 }
  634:                 else
  635:                 {
  636:                     fprintf(flux, "\n");
  637:                 }
  638:             }
  639:         }
  640:         else
  641:         {
  642:             fprintf(flux, "    Return            = no\n");
  643:         }
  644: 
  645:         if (((*l_element_courant).indice_boucle != NULL) &&
  646:                 ((*l_element_courant).type_cloture != 'A'))
  647:         {
  648:             tampon = formateur(s_etat_processus, 24,
  649:                     (*l_element_courant).indice_boucle);
  650:             fprintf(flux, "    Index             = %s\n", tampon);
  651:             free(tampon);
  652:         }
  653: 
  654:         if ((*l_element_courant).limite_indice_boucle != NULL)
  655:         {
  656:             tampon = formateur(s_etat_processus, 24,
  657:                     (*l_element_courant).limite_indice_boucle);
  658:             fprintf(flux, "    Limit             = %s\n", tampon);
  659:             free(tampon);
  660:         }
  661: 
  662:         if ((*l_element_courant).objet_de_test != NULL)
  663:         {
  664:             tampon = formateur(s_etat_processus, 24,
  665:                     (*l_element_courant).objet_de_test);
  666:             fprintf(flux, "    Test object       = %s\n", tampon);
  667:             free(tampon);
  668:         }
  669: 
  670:         if ((*l_element_courant).nom_variable != NULL)
  671:         {
  672:             fprintf(flux, "    Variable name     = %s\n",
  673:                     (*l_element_courant).nom_variable);
  674:         }
  675: 
  676:         fprintf(flux, "\n");
  677: 
  678:         l_element_courant = (*l_element_courant).suivant;
  679:     }
  680: 
  681:     funlockfile(flux);
  682: 
  683:     free(tableau);
  684: 
  685:     return;
  686: }
  687: 
  688: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>