Annotation of rpl/src/gestion_pile_systeme.c, revision 1.48

1.1       bertrand    1: /*
                      2: ================================================================================
1.47      bertrand    3:   RPL/2 (R) version 4.1.12
1.40      bertrand    4:   Copyright (C) 1989-2012 Dr. BERTRAND Joël
1.1       bertrand    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: 
1.19      bertrand   23: #include "rpl-conv.h"
1.1       bertrand   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:            ((*s_etat_processus).estimation_taille_pile_systeme_tampon *
                     43:            ((double) 0.9)) + ((*s_etat_processus)
                     44:            .hauteur_pile_systeme * ((double) 0.1));
                     45:    return;
                     46: }
                     47: 
                     48: 
                     49: /*
                     50: ================================================================================
                     51:   Procédure d'empilement d'un nouvel élément
                     52: ================================================================================
                     53:   Entrée :
                     54: --------------------------------------------------------------------------------
                     55:   Sortie :
                     56: --------------------------------------------------------------------------------
                     57:   Effets de bord : néant
                     58: ================================================================================
                     59: */
                     60: 
                     61: void
                     62: empilement_pile_systeme(struct_processus *s_etat_processus)
                     63: {
                     64:    struct_liste_pile_systeme       *l_ancienne_base_liste;
                     65:    struct_liste_pile_systeme       *l_nouvelle_base_liste;
                     66: 
                     67:    l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;
                     68: 
                     69:    if ((*s_etat_processus).debug == d_vrai)
                     70:        if (((*s_etat_processus).type_debug &
                     71:                d_debug_pile_systeme) != 0)
                     72:    {
                     73:        if (strlen((*s_etat_processus).instruction_courante) != 0)
                     74:        {
                     75:            if ((*s_etat_processus).langue == 'F')
                     76:            {
                     77:                printf("[%d] Empilement sur la pile système à la suite de "
                     78:                        "l'instruction %s\n", (int) getpid(),
                     79:                        (*s_etat_processus).instruction_courante);
                     80:            }
                     81:            else
                     82:            {
                     83:                printf("[%d] Pushing on system stack (instruction %s)\n",
                     84:                        (int) getpid(),
                     85:                        (*s_etat_processus).instruction_courante);
                     86:            }
                     87:        }
                     88:        else
                     89:        {
                     90:            if ((*s_etat_processus).langue == 'F')
                     91:            {
                     92:                printf("[%d] Empilement sur la pile système\n",
                     93:                        (int) getpid());
                     94:            }
                     95:            else
                     96:            {
                     97:                printf("[%d] Pushing on system stack\n", (int) getpid());
                     98:            }
                     99:        }
                    100: 
                    101:        fflush(stdout);
                    102:    }
                    103: 
                    104:    if ((*s_etat_processus).pile_systeme_tampon == NULL)
                    105:    {
                    106:        // Tampon vide, on alloue un élément.
                    107: 
                    108:        if ((l_nouvelle_base_liste = malloc(sizeof(struct_liste_pile_systeme)))
                    109:                == NULL)
                    110:        {
                    111:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    112:            return;
                    113:        }
                    114:    }
                    115:    else
                    116:    {
                    117:        // Tampon utilisable, on retire un élément du tampon.
                    118: 
                    119:        l_nouvelle_base_liste = (*s_etat_processus).pile_systeme_tampon;
                    120:        (*s_etat_processus).pile_systeme_tampon =
                    121:                (*l_nouvelle_base_liste).suivant;
                    122:        (*s_etat_processus).taille_pile_systeme_tampon--;
                    123:    }
                    124: 
                    125:    (*s_etat_processus).hauteur_pile_systeme++;
                    126:    (*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
                    127:    (*(*s_etat_processus).l_base_pile_systeme).suivant =
                    128:            l_ancienne_base_liste;
                    129: 
                    130:    (*(*s_etat_processus).l_base_pile_systeme).type_cloture = ' ';
                    131:    (*(*s_etat_processus).l_base_pile_systeme).clause = ' ';
                    132:    (*(*s_etat_processus).l_base_pile_systeme).adresse_retour = 0;
                    133:    (*(*s_etat_processus).l_base_pile_systeme).niveau_courant = 0;
1.16      bertrand  134:    (*(*s_etat_processus).l_base_pile_systeme).pointeur_adresse_retour = NULL;
1.1       bertrand  135:    (*(*s_etat_processus).l_base_pile_systeme).retour_definition = 'N';
                    136:    (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
                    137:    (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = NULL;
                    138:    (*(*s_etat_processus).l_base_pile_systeme).objet_de_test = NULL;
                    139:    (*(*s_etat_processus).l_base_pile_systeme).nom_variable = NULL;
                    140:    (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour = NULL;
                    141:    (*(*s_etat_processus).l_base_pile_systeme)
                    142:            .origine_routine_evaluation = 'N';
                    143:    (*(*s_etat_processus).l_base_pile_systeme).arret_si_exception =
                    144:            (*s_etat_processus).arret_si_exception;
                    145:    (*(*s_etat_processus).l_base_pile_systeme).creation_variables_statiques
                    146:            = (*s_etat_processus).creation_variables_statiques;
                    147:    (*(*s_etat_processus).l_base_pile_systeme).creation_variables_partagees
                    148:            = (*s_etat_processus).creation_variables_partagees;
                    149:    (*(*s_etat_processus).l_base_pile_systeme).evaluation_expression =
                    150:            d_faux;
                    151: 
                    152:    (*s_etat_processus).erreur_systeme = d_es;
                    153:    (*s_etat_processus).creation_variables_statiques = d_faux;
                    154:    (*s_etat_processus).creation_variables_partagees = d_faux;
                    155: 
                    156:    return;
                    157: }
                    158: 
                    159: 
                    160: /*
                    161: ================================================================================
                    162:   Procédure de dépilement d'un élément
                    163: ================================================================================
                    164:   Entrée :
                    165: --------------------------------------------------------------------------------
                    166:   Sortie :
                    167: --------------------------------------------------------------------------------
                    168:   Effets de bord : néant
                    169: ================================================================================
                    170: */
                    171: 
                    172: void
                    173: depilement_pile_systeme(struct_processus *s_etat_processus)
                    174: {
                    175:    struct_liste_pile_systeme       *l_ancienne_base_liste;
                    176:    struct_liste_pile_systeme       *l_nouvelle_base_liste;
                    177: 
                    178:    if ((*s_etat_processus).debug == d_vrai)
                    179:        if (((*s_etat_processus).type_debug &
                    180:                d_debug_pile_systeme) != 0)
                    181:    {
                    182:        if (strlen((*s_etat_processus).instruction_courante) != 0)
                    183:        {
                    184:            if ((*s_etat_processus).langue == 'F')
                    185:            {
                    186:                printf("[%d] Dépilement de la pile système à la suite "
                    187:                        "de l'instruction %s\n", (int) getpid(),
                    188:                        (*s_etat_processus).instruction_courante);
                    189:            }
                    190:            else
                    191:            {
                    192:                printf("[%d] Pulling from system stack (instruction %s)\n",
                    193:                        (int) getpid(),
                    194:                        (*s_etat_processus).instruction_courante);
                    195:            }
                    196:        }
                    197:        else
                    198:        {
                    199:            if ((*s_etat_processus).langue == 'F')
                    200:            {
                    201:                printf("[%d] Dépilement de la pile système\n",
                    202:                        (int) getpid());
                    203:            }
                    204:            else
                    205:            {
                    206:                printf("[%d] Pulling from system stack\n", (int) getpid());
                    207:            }
                    208:        }
                    209: 
                    210:        fflush(stdout);
                    211:    }
                    212: 
                    213:    if ((*s_etat_processus).l_base_pile_systeme == NULL)
                    214:    {
                    215:        (*s_etat_processus).erreur_systeme = d_es_pile_vide;
                    216:    }
                    217:    else
                    218:    {
                    219:        (*s_etat_processus).hauteur_pile_systeme--;
                    220:        l_ancienne_base_liste = (*s_etat_processus).l_base_pile_systeme;
                    221:        l_nouvelle_base_liste = (*l_ancienne_base_liste).suivant;
                    222: 
                    223:        (*s_etat_processus).l_base_pile_systeme = l_nouvelle_base_liste;
                    224:        (*s_etat_processus).erreur_systeme = d_es;
                    225: 
                    226:        // On positionne le drapeau de création des variables statiques.
                    227: 
                    228:        (*s_etat_processus).creation_variables_statiques =
                    229:                 (*l_ancienne_base_liste).creation_variables_statiques;
                    230:        (*s_etat_processus).creation_variables_partagees =
                    231:                 (*l_ancienne_base_liste).creation_variables_partagees;
                    232: 
                    233:        if ((*l_ancienne_base_liste).nom_variable != NULL)
                    234:        {
                    235:            free((*l_ancienne_base_liste).nom_variable);
                    236:        }
                    237: 
                    238:        liberation(s_etat_processus, (*l_ancienne_base_liste).indice_boucle);
                    239:        liberation(s_etat_processus,
                    240:                (*l_ancienne_base_liste).limite_indice_boucle);
                    241:        liberation(s_etat_processus, (*l_ancienne_base_liste).objet_de_test);
                    242: 
                    243:        if ((*s_etat_processus).taille_pile_systeme_tampon <= (10 *
                    244:                ((*s_etat_processus).estimation_taille_pile_systeme_tampon
                    245:                + 1)))
                    246:        {
                    247:            // Enregistrement de la structure pour un usage ultérieur.
                    248: 
                    249:            (*l_ancienne_base_liste).suivant =
                    250:                    (*s_etat_processus).pile_systeme_tampon;
                    251:            (*s_etat_processus).pile_systeme_tampon = l_ancienne_base_liste;
                    252:            (*s_etat_processus).taille_pile_systeme_tampon++;
                    253:        }
                    254:        else
                    255:        {
                    256:            // Libération car le tampon est plein.
                    257: 
                    258:            free(l_ancienne_base_liste);
                    259:        }
                    260:    }
                    261: 
                    262:    return;
                    263: }
                    264: 
1.7       bertrand  265: 
                    266: /*
                    267: ================================================================================
                    268:   Procédure d'effacement de la pile système
                    269: ================================================================================
                    270:   Entrée :
                    271: --------------------------------------------------------------------------------
                    272:   Sortie :
                    273: --------------------------------------------------------------------------------
                    274:   Effets de bord : néant
                    275: ================================================================================
                    276: */
                    277: 
                    278: void
                    279: effacement_pile_systeme(struct_processus *s_etat_processus)
                    280: {
                    281:    while((*s_etat_processus).l_base_pile_systeme != NULL)
                    282:    {
                    283:        depilement_pile_systeme(s_etat_processus);
                    284:    }
                    285: 
                    286:    return;
                    287: }
                    288: 
1.12      bertrand  289: 
                    290: /*
                    291: ================================================================================
                    292:   Procédure d'affichage de la pile système
                    293: ================================================================================
                    294:   Entrée :
                    295: --------------------------------------------------------------------------------
                    296:   Sortie :
                    297: --------------------------------------------------------------------------------
                    298:   Effets de bord : néant
                    299: ================================================================================
                    300: */
                    301: 
                    302: void
                    303: trace(struct_processus *s_etat_processus, FILE *flux)
                    304: {
1.15      bertrand  305:    integer8                        i;
1.16      bertrand  306:    integer8                        candidat;
                    307: 
                    308:    long                            delta;
1.15      bertrand  309: 
1.26      bertrand  310:    struct_liste_chainee            *l_variable;
                    311:    struct_liste_chainee            *l_candidat;
                    312: 
1.12      bertrand  313:    struct_liste_pile_systeme       *l_element_courant;
                    314: 
1.15      bertrand  315:    unsigned char                   *tampon;
1.12      bertrand  316: 
                    317:    l_element_courant = (*s_etat_processus).l_base_pile_systeme;
                    318:    i = 0;
                    319: 
                    320:    while(l_element_courant != NULL)
                    321:    {
                    322:        i++;
                    323:        l_element_courant = (*l_element_courant).suivant;
                    324:    }
                    325: 
                    326:    l_element_courant = (*s_etat_processus).l_base_pile_systeme;
                    327:    flockfile(flux);
                    328: 
                    329:    if ((flux == stderr) || (flux == stdout))
                    330:    {
                    331:        fprintf(flux, "+++Backtrace\n");
                    332:    }
                    333: 
                    334:    while(l_element_courant != NULL)
                    335:    {
1.16      bertrand  336:        fprintf(flux, "%d : (%016X) D=", i--, l_element_courant);
1.12      bertrand  337: 
                    338:        fprintf(flux, ((*l_element_courant).creation_variables_statiques
                    339:                == d_vrai) ? "1" : "0");
                    340:        fprintf(flux, ((*l_element_courant).creation_variables_partagees
                    341:                == d_vrai) ? "1" : "0");
                    342:        fprintf(flux, ((*l_element_courant).arret_si_exception == d_vrai)
                    343:                ? "1" : "0");
                    344:        fprintf(flux, ((*l_element_courant).evaluation_expression == d_vrai)
                    345:                ? "1" : "0");
                    346: 
                    347:        fprintf(flux, " F=%c%c L=%lu ",
                    348:                ((*l_element_courant).clause == ' ') ? '-' :
                    349:                (*l_element_courant).clause,
                    350:                ((*l_element_courant).type_cloture == ' ') ? '-' :
                    351:                (*l_element_courant).type_cloture,
                    352:                (*l_element_courant).niveau_courant);
                    353: 
                    354:        if ((*l_element_courant).retour_definition == 'Y')
                    355:        {
1.26      bertrand  356:            fprintf(flux, "RTN ");
1.12      bertrand  357: 
                    358:            if ((*l_element_courant).origine_routine_evaluation == 'Y')
                    359:            {
                    360:                fprintf(flux, "EVL ");
1.16      bertrand  361:            }
                    362:            else
                    363:            {
                    364:                fprintf(flux, "SEQ ");
1.12      bertrand  365: 
                    366:                if ((*l_element_courant).adresse_retour != 0)
                    367:                {
1.16      bertrand  368:                    fprintf(flux, "P=%016X", (*l_element_courant)
1.12      bertrand  369:                            .adresse_retour);
1.16      bertrand  370: 
                    371:                    // Calcul de la routine de départ
                    372: 
1.26      bertrand  373:                    l_variable = (struct_liste_chainee *)
                    374:                            (*(*(*s_etat_processus)
1.27      bertrand  375:                            .l_liste_variables_par_niveau).precedent).liste;
1.16      bertrand  376:                    candidat = (*s_etat_processus)
                    377:                            .longueur_definitions_chainees;
1.26      bertrand  378:                    l_candidat = NULL;
                    379: 
                    380:                    // l_variable balaie les variables de niveau 0.
1.16      bertrand  381: 
1.26      bertrand  382:                    while(l_variable != NULL)
1.16      bertrand  383:                    {
1.26      bertrand  384:                        if ((*(*((struct_variable *) (*l_variable).donnee))
                    385:                                .objet).type == ADR)
1.16      bertrand  386:                        {
                    387:                            delta = (*l_element_courant).adresse_retour
                    388:                                    - (*((unsigned long *)
1.26      bertrand  389:                                    (*(*((struct_variable *) (*l_variable)
                    390:                                    .donnee)).objet).objet));
1.16      bertrand  391: 
                    392:                            if ((delta > 0) && (delta < candidat))
                    393:                            {
                    394:                                candidat = delta;
1.26      bertrand  395:                                l_candidat = l_variable;
1.16      bertrand  396:                            }
                    397:                        }
1.26      bertrand  398: 
                    399:                        l_variable = (*l_variable).suivant;
1.16      bertrand  400:                    }
                    401: 
1.26      bertrand  402:                    if (l_candidat != NULL)
1.16      bertrand  403:                    {
1.26      bertrand  404:                        fprintf(flux, "\n  Call from %s",
                    405:                                (*((struct_variable *) (*l_candidat).donnee))
                    406:                                .nom);
1.16      bertrand  407:                    }
                    408:                    else
                    409:                    {
                    410:                        fprintf(flux, "\n  Call from RPL/2 initialization");
                    411:                    }
1.12      bertrand  412:                }
1.16      bertrand  413:                else
1.12      bertrand  414:                {
1.16      bertrand  415:                    fprintf(flux, "RPL/2 initialization");
1.12      bertrand  416:                }
                    417:            }
                    418:        }
                    419:        else
                    420:        {
                    421:            fprintf(flux, "NONE ");
                    422: 
                    423:            if ((*l_element_courant).origine_routine_evaluation == 'Y')
                    424:            {
                    425:                fprintf(flux, "EVL ");
                    426:            }
                    427:            else
                    428:            {
                    429:                fprintf(flux, "SEQ ");
                    430: 
1.16      bertrand  431:                if ((*l_element_courant).pointeur_adresse_retour != NULL)
1.12      bertrand  432:                {
1.16      bertrand  433:                    fprintf(flux, "A=%016X ", (*l_element_courant)
                    434:                            .pointeur_adresse_retour);
                    435: 
                    436:                    // Calcul de la routine de départ
                    437: 
1.26      bertrand  438:                    l_variable = (struct_liste_chainee *)
                    439:                            (*(*(*s_etat_processus)
1.27      bertrand  440:                            .l_liste_variables_par_niveau).precedent).liste;
1.26      bertrand  441:                    candidat = (*s_etat_processus)
                    442:                            .longueur_definitions_chainees;
                    443:                    l_candidat = NULL;
                    444: 
                    445:                    // l_variable balaie les variables de niveau 0.
1.16      bertrand  446: 
1.26      bertrand  447:                    while(l_variable != NULL)
1.16      bertrand  448:                    {
1.26      bertrand  449:                        if ( (*(*l_variable).donnee).objet ==
                    450:                                (*l_element_courant).pointeur_adresse_retour)
1.16      bertrand  451:                        {
1.26      bertrand  452:                            l_candidat = l_variable;
                    453:                            break;
1.16      bertrand  454:                        }
1.26      bertrand  455: 
                    456:                        l_variable = (*l_variable).suivant;
1.16      bertrand  457:                    }
                    458: 
1.26      bertrand  459:                    if (l_candidat != NULL)
1.16      bertrand  460:                    {
1.26      bertrand  461:                        fprintf(flux, "\n  Branch to %s",
                    462:                                (*((struct_variable *) (*l_candidat).donnee))
                    463:                                .nom);
1.16      bertrand  464:                    }
                    465:                    else
                    466:                    {
1.17      bertrand  467:                        fprintf(flux, "\n  Branch to evaluation subroutine");
1.16      bertrand  468:                    }
1.12      bertrand  469:                }
                    470:            }
                    471:        }
                    472: 
                    473:        fprintf(flux, "\n");
                    474: 
1.15      bertrand  475:        if ((*l_element_courant).indice_boucle != NULL)
                    476:        {
                    477:            tampon = formateur(s_etat_processus, 0,
                    478:                    (*l_element_courant).indice_boucle);
                    479:            fprintf(flux, "  Index         = %s\n", tampon);
                    480:            free(tampon);
                    481:        }
                    482: 
                    483:        if ((*l_element_courant).limite_indice_boucle != NULL)
                    484:        {
                    485:            tampon = formateur(s_etat_processus, 0,
                    486:                    (*l_element_courant).limite_indice_boucle);
                    487:            fprintf(flux, "  Limit         = %s\n", tampon);
                    488:            free(tampon);
                    489:        }
                    490: 
                    491:        if ((*l_element_courant).objet_de_test != NULL)
                    492:        {
                    493:            tampon = formateur(s_etat_processus, 0,
                    494:                    (*l_element_courant).objet_de_test);
                    495:            fprintf(flux, "  Test object   = %s\n", tampon);
                    496:            free(tampon);
                    497:        }
                    498: 
                    499:        if ((*l_element_courant).nom_variable != NULL)
                    500:        {
                    501:            fprintf(flux, "  Variable name = %s\n",
                    502:                    (*l_element_courant).nom_variable);
                    503:        }
                    504: 
1.12      bertrand  505:        l_element_courant = (*l_element_courant).suivant;
                    506:    }
                    507: 
                    508:    fprintf(flux, "\n");
                    509:    funlockfile(flux);
                    510: 
                    511:    return;
                    512: }
                    513: 
1.1       bertrand  514: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>