Annotation of rpl/src/gestion_pile.c, revision 1.63

1.1       bertrand    1: /*
                      2: ================================================================================
1.63    ! bertrand    3:   RPL/2 (R) version 4.1.24
1.58      bertrand    4:   Copyright (C) 1989-2015 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.14      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(struct_processus *s_etat_processus)
                     40: {
                     41:    /*
                     42:     * Cette fonction permet d'estimer un volant de structures de maillons
                     43:     * de liste chaînée pour le programme courant et évite un certain nombre
                     44:     * d'allocations de mémoire lors des manipulations de la pile. Cette taille
                     45:     * est estimée au travers d'une chaîne de Markov.
                     46:     */
                     47: 
1.9       bertrand   48:    if ((*s_etat_processus).hauteur_pile_operationnelle >
                     49:            (*s_etat_processus).estimation_taille_pile_tampon)
                     50:    {
                     51:        (*s_etat_processus).estimation_taille_pile_tampon =
                     52:                (*s_etat_processus).estimation_taille_pile_tampon;
                     53:    }
                     54:    else
                     55:    {
                     56:        (*s_etat_processus).estimation_taille_pile_tampon =
1.47      bertrand   57:                (((double) (*s_etat_processus).estimation_taille_pile_tampon) *
                     58:                ((double) 0.95)) + (((double) (*s_etat_processus)
                     59:                .hauteur_pile_operationnelle) * ((double) 0.05));
1.9       bertrand   60:    }
                     61: 
1.1       bertrand   62:    return;
                     63: }
                     64: 
                     65: 
                     66: /*
                     67: ================================================================================
                     68:   Procédure d'empilement d'un nouvel élément
                     69: ================================================================================
                     70:   Entrée :
                     71: --------------------------------------------------------------------------------
                     72:   Sortie :
                     73: --------------------------------------------------------------------------------
                     74:   Effets de bord : néant
                     75: ================================================================================
                     76: */
                     77: 
                     78: logical1
                     79: empilement(struct_processus *s_etat_processus,
                     80:        struct_liste_chainee **l_base_pile, struct_objet *s_objet)
                     81: {
                     82:    struct_liste_chainee        *l_ancienne_base_liste;
                     83:    struct_liste_chainee        *l_nouvelle_base_liste;
                     84: 
                     85:    logical1                    erreur;
                     86: 
                     87:    l_ancienne_base_liste = *l_base_pile;
                     88: 
                     89:    if ((*s_etat_processus).pile_tampon == NULL)
                     90:    {
                     91:        // Tampon vide, on alloue un élément.
                     92: 
                     93:        if ((l_nouvelle_base_liste = malloc(sizeof(struct_liste_chainee)))
                     94:                == NULL)
                     95:        {
                     96:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                     97:            return(d_erreur);
                     98:        }
                     99:    }
                    100:    else
                    101:    {
                    102:        // Tampon utilisable, on retire un élément du tampon.
                    103: 
                    104:        l_nouvelle_base_liste = (*s_etat_processus).pile_tampon;
                    105:        (*s_etat_processus).pile_tampon = (*l_nouvelle_base_liste).suivant;
                    106:        (*s_etat_processus).taille_pile_tampon--;
                    107:    }
                    108: 
                    109:    *l_base_pile = l_nouvelle_base_liste;
                    110:    (**l_base_pile).donnee = s_objet;
                    111:    (**l_base_pile).suivant = l_ancienne_base_liste;
                    112: 
                    113:    erreur = d_absence_erreur;
                    114: 
                    115: /*
                    116: -- Ne considère que la pile opérationnelle -------------------------------------
                    117: */
                    118: 
                    119:    if ((*s_etat_processus).l_base_pile == *l_base_pile)
                    120:    {
                    121:        (*s_etat_processus).hauteur_pile_operationnelle++;
                    122:        estimation_taille_pile(s_etat_processus);
                    123: 
                    124:        if ((*s_etat_processus).debug == d_vrai)
                    125:            if (((*s_etat_processus).type_debug &
                    126:                    d_debug_pile_utilisateur) != 0)
                    127:        {
                    128:            if ((*s_etat_processus).langue == 'F')
                    129:            {
                    130:                printf("[%d] Empilement de type %d "
1.49      bertrand  131:                        "(profondeur %lld)\n", (int) getpid(),
1.1       bertrand  132:                        (*s_objet).type,
                    133:                        (*s_etat_processus).hauteur_pile_operationnelle);
                    134:            }
                    135:            else
                    136:            {
                    137:                printf("[%d] Pushing a type %d object "
1.49      bertrand  138:                        "(depth %lld)\n", (int) getpid(), (*s_objet).type,
1.1       bertrand  139:                        (*s_etat_processus).hauteur_pile_operationnelle);
                    140:            }
                    141: 
                    142:            fflush(stdout);
                    143:        }
                    144:    }
                    145: 
                    146:    return erreur;
                    147: }
                    148: 
                    149: 
                    150: /*
                    151: ================================================================================
                    152:   Procédure de dépilement d'un élément. L'emplacement est libéré dans la pile.
                    153: ================================================================================
                    154:   Entrée :
                    155: --------------------------------------------------------------------------------
                    156:   Sortie :
                    157: --------------------------------------------------------------------------------
                    158:   Effets de bord : néant
                    159: ================================================================================
                    160: */
                    161: 
                    162: logical1
                    163: depilement(struct_processus *s_etat_processus,
                    164:        struct_liste_chainee **l_base_pile, struct_objet **s_objet)
                    165: {
                    166:    struct_liste_chainee        *l_ancienne_base_liste;
                    167:    struct_liste_chainee        *l_nouvelle_base_liste;
                    168: 
                    169:    logical1                    erreur;
                    170: 
                    171:    if (*l_base_pile == NULL)
                    172:    {
                    173:        (*s_etat_processus).erreur_execution = d_ex_pile_vide;
                    174:        erreur = d_erreur;
                    175:    }
                    176:    else
                    177:    {
                    178: 
                    179: /*
                    180: -- Ne considère que la pile opérationnelle -------------------------------------
                    181: */
                    182: 
                    183:        l_ancienne_base_liste = *l_base_pile;
                    184:        *s_objet = (*l_ancienne_base_liste).donnee;
                    185: 
                    186:        if ((*s_etat_processus).l_base_pile == *l_base_pile)
                    187:        {
                    188:            if ((*s_etat_processus).debug == d_vrai)
                    189:                if (((*s_etat_processus).type_debug &
                    190:                        d_debug_pile_utilisateur) != 0)
                    191:            {
                    192:                if ((*s_etat_processus).langue == 'F')
                    193:                {
                    194:                    printf("[%d] Dépilement de type %d "
1.49      bertrand  195:                            "(profondeur %lld)\n", (int) getpid(),
1.1       bertrand  196:                            (*(*s_objet)).type,
                    197:                            (*s_etat_processus).hauteur_pile_operationnelle);
                    198:                }
                    199:                else
                    200:                {
                    201:                    printf("[%d] Pulling a type %d object "
1.49      bertrand  202:                            "(depth %lld)\n", (int) getpid(),
                    203:                            (*(*s_objet)).type,
1.1       bertrand  204:                            (*s_etat_processus).hauteur_pile_operationnelle);
                    205:                }
                    206: 
                    207:                fflush(stdout);
                    208:            }
                    209: 
                    210:            (*s_etat_processus).hauteur_pile_operationnelle--;
                    211:            estimation_taille_pile(s_etat_processus);
                    212:        }
                    213: 
                    214:        l_nouvelle_base_liste = (*l_ancienne_base_liste).suivant;
                    215: 
                    216:        *l_base_pile = l_nouvelle_base_liste;
                    217:        erreur = d_absence_erreur;
                    218: 
                    219:        if ((*s_etat_processus).taille_pile_tampon <= (10 * ((*s_etat_processus)
                    220:                .estimation_taille_pile_tampon + 1)))
                    221:        {
                    222:            // Enregistrement de la structure pour usage ultérieur.
                    223: 
                    224:            (*l_ancienne_base_liste).donnee = NULL;
                    225:            (*l_ancienne_base_liste).suivant = (*s_etat_processus).pile_tampon;
                    226:            (*s_etat_processus).pile_tampon = l_ancienne_base_liste;
                    227:            (*s_etat_processus).taille_pile_tampon++;
                    228:        }
                    229:        else
                    230:        {
                    231:            // Libération car le tampon est plein.
                    232: 
                    233:            free(l_ancienne_base_liste);
                    234:        }
                    235:    }
                    236: 
                    237:    return erreur;
                    238: }
                    239: 
                    240: 
                    241: /*
                    242: ================================================================================
                    243:   Procédures affichant la pile opérationnelle
                    244: ================================================================================
                    245:   Entrée :
                    246: --------------------------------------------------------------------------------
                    247:   Sortie :
                    248: --------------------------------------------------------------------------------
                    249:   Effets de bord : néant
                    250: ================================================================================
                    251: */
                    252: 
                    253: void
                    254: affichage_pile(struct_processus *s_etat_processus, struct_liste_chainee
1.47      bertrand  255:        *l_element_courant, integer8 niveau_courant)
1.1       bertrand  256: {
1.3       bertrand  257:    unsigned char           registre;
                    258: 
                    259:    registre = (*s_etat_processus).autorisation_conversion_chaine;
                    260:    (*s_etat_processus).autorisation_conversion_chaine = 'N';
                    261: 
1.31      bertrand  262:    routine_recursive = 1;
1.1       bertrand  263:    ecriture_pile(s_etat_processus, stdout, l_element_courant, niveau_courant);
1.31      bertrand  264:    routine_recursive = 0;
1.3       bertrand  265: 
                    266:    (*s_etat_processus).autorisation_conversion_chaine = registre;
1.1       bertrand  267:    return;
                    268: }
                    269: 
1.56      bertrand  270: // Bug de gcc à partir de gcc 4.6 (bug 48544)
                    271: #pragma GCC diagnostic push
                    272: #pragma GCC diagnostic ignored "-Wclobbered"
                    273: 
1.1       bertrand  274: void
                    275: ecriture_pile(struct_processus *s_etat_processus, file *flux,
1.47      bertrand  276:        struct_liste_chainee *l, integer8 niveau_courant)
1.1       bertrand  277: {
                    278:    unsigned char               *chaine;
                    279:    unsigned char               *registre;
                    280:    unsigned char               tampon[32 + 1];
                    281: 
1.34      bertrand  282:    // Évite le warning : argument l_element_courant might be clobbered by
                    283:    // longjmp or vfork
                    284:    volatile struct_liste_chainee   *l_element_courant;
                    285: 
                    286:    l_element_courant = l;
                    287: 
1.1       bertrand  288:    if (l_element_courant != NULL)
                    289:    {
1.31      bertrand  290:        if (setjmp(contexte_ecriture) == 0)
1.1       bertrand  291:        {
                    292:            (*s_etat_processus).var_volatile_recursivite = -1;
                    293:            ecriture_pile(s_etat_processus, flux,
                    294:                    (*l_element_courant).suivant, niveau_courant + 1);
                    295: 
                    296:            if ((*s_etat_processus).var_volatile_recursivite > 0)
                    297:            {
                    298:                (*s_etat_processus).var_volatile_recursivite--;
                    299: 
                    300:                if ((*s_etat_processus).var_volatile_recursivite == 0)
                    301:                {
1.49      bertrand  302:                    if (fprintf(flux, "%lld: ...\n", niveau_courant) < 0)
1.1       bertrand  303:                    {
                    304:                        (*s_etat_processus).erreur_systeme =
                    305:                                d_es_erreur_fichier;
                    306:                        return;
                    307:                    }
                    308: 
                    309:                    while(l_element_courant != NULL)
                    310:                    {
                    311:                        l_element_courant = (*l_element_courant).suivant;
                    312:                    }
                    313:                }
                    314: 
                    315:                return;
                    316:            }
                    317: 
                    318:            (*s_etat_processus).var_volatile_recursivite = 0;
                    319:        }
                    320:        else
                    321:        {
                    322:            // Libération de n appels de la pile système qui permet de
                    323:            // terminer la récursion sans autre dépassement de pile.
                    324: 
                    325:            (*s_etat_processus).var_volatile_recursivite = 64;
                    326:            return;
                    327:        }
                    328: 
1.47      bertrand  329:        sprintf(tampon, "%lld: ", niveau_courant);
1.1       bertrand  330: 
1.47      bertrand  331:        if ((chaine = formateur(s_etat_processus, (long) strlen(tampon),
1.1       bertrand  332:                (*l_element_courant).donnee)) == NULL)
                    333:        {
                    334:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    335:            return;
                    336:        }
                    337: 
                    338:        if ((*(*l_element_courant).donnee).type == CHN)
                    339:        {
                    340:            registre = chaine;
                    341: 
                    342:            if ((chaine = (unsigned char *) malloc((strlen(registre) + 3) *
                    343:                    sizeof(unsigned char))) == NULL)
                    344:            {
                    345:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    346:                return;
                    347:            }
                    348: 
                    349:            sprintf(chaine, "\"%s\"", registre);
                    350:            free(registre);
                    351:        }
                    352: 
1.49      bertrand  353:        if (fprintf(flux, "%lld: %s\n", niveau_courant, chaine) < 0)
1.1       bertrand  354:        {
                    355:            (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
                    356:            return;
                    357:        }
                    358: 
                    359:        free(chaine);
                    360:    }
                    361: 
                    362:    return;
                    363: }
                    364: 
                    365: 
                    366: /*
                    367: ================================================================================
                    368:   Procédure imprimant la pile opérationnelle
                    369: ================================================================================
                    370:   Entrée : méthode 'C' = compacte, 'E' = étendue
                    371: --------------------------------------------------------------------------------
                    372:   Sortie :
                    373: --------------------------------------------------------------------------------
                    374:   Effets de bord : néant
                    375: ================================================================================
                    376: */
                    377: 
                    378: void
                    379: impression_pile(struct_processus *s_etat_processus,
1.47      bertrand  380:        struct_liste_chainee *l, unsigned char methode, integer8 niveau_courant)
1.1       bertrand  381: {
                    382:    struct_objet                s_objet;
                    383: 
                    384:    unsigned char               *chaine;
                    385:    unsigned char               *registre;
                    386:    unsigned char               tampon[32 + 1];
                    387: 
1.34      bertrand  388:    // Évite le warning : argument l_element_courant might be clobbered by
                    389:    // longjmp or vfork
                    390:    volatile struct_liste_chainee   *l_element_courant;
                    391: 
                    392:    l_element_courant = l;
                    393: 
1.1       bertrand  394:    if (l_element_courant != NULL)
                    395:    {
1.31      bertrand  396:        if (setjmp(contexte_impression) == 0)
1.1       bertrand  397:        {
                    398:            (*s_etat_processus).var_volatile_recursivite = -1;
                    399:            impression_pile(s_etat_processus, (*l_element_courant).suivant,
                    400:                    methode, niveau_courant + 1);
                    401: 
                    402:            if ((*s_etat_processus).var_volatile_recursivite > 0)
                    403:            {
                    404:                (*s_etat_processus).var_volatile_recursivite--;
                    405: 
                    406:                if ((*s_etat_processus).var_volatile_recursivite == 0)
                    407:                {
                    408:                    while(l_element_courant != NULL)
                    409:                    {
                    410:                        l_element_courant = (*l_element_courant).suivant;
                    411:                    }
                    412:                }
                    413: 
                    414:                return;
                    415:            }
                    416: 
                    417:            (*s_etat_processus).var_volatile_recursivite = 0;
                    418:        }
                    419:        else
                    420:        {
                    421:            (*s_etat_processus).var_volatile_recursivite = 16;
                    422:            return;
                    423:        }
                    424: 
                    425:        if (methode == 'C')
                    426:        {
                    427:            s_objet.type = CHN;
1.47      bertrand  428:            sprintf(tampon, "%lld: ", niveau_courant);
1.1       bertrand  429: 
1.47      bertrand  430:            if ((chaine = formateur(s_etat_processus, (long) strlen(tampon),
1.1       bertrand  431:                    (*l_element_courant).donnee)) == NULL)
                    432:            {
                    433:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    434:                return;
                    435:            }
                    436: 
                    437:            if ((*(*l_element_courant).donnee).type == CHN)
                    438:            {
                    439:                registre = chaine;
                    440: 
                    441:                if ((chaine = (unsigned char *) malloc((strlen(registre) + 3) *
                    442:                        sizeof(unsigned char))) == NULL)
                    443:                {
                    444:                    (*s_etat_processus).erreur_systeme =
                    445:                            d_es_allocation_memoire;
                    446:                    return;
                    447:                }
                    448: 
                    449:                sprintf(chaine, "\"%s\"", registre);
                    450:                free(registre);
                    451:            }
                    452: 
                    453:            if ((s_objet.objet = malloc((strlen(chaine) + 64) *
                    454:                    sizeof(unsigned char))) == NULL)
                    455:            {
                    456:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    457:                return;
                    458:            }
                    459: 
                    460:            sprintf((unsigned char *) s_objet.objet,
1.47      bertrand  461:                    "\n\\noindent\\begin{verbatim}\n%lld: %s\n\\end{verbatim}",
1.1       bertrand  462:                    niveau_courant, chaine);
                    463:            free(chaine);
                    464: 
                    465:            formateur_tex(s_etat_processus, &s_objet, 'V');
                    466:            free(s_objet.objet);
                    467:        }
                    468:        else
                    469:        {
                    470:            formateur_tex(s_etat_processus, (*l_element_courant).donnee, 'N');
                    471:        }
                    472:    }
                    473: 
                    474:    return;
                    475: }
                    476: 
1.56      bertrand  477: #pragma GCC diagnostic pop
                    478: 
1.1       bertrand  479: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>