Annotation of rpl/src/sequenceur.c, revision 1.106

1.1       bertrand    1: /*
                      2: ================================================================================
1.105     bertrand    3:   RPL/2 (R) version 4.1.31
1.103     bertrand    4:   Copyright (C) 1989-2019 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: 
1.13      bertrand   22: 
1.20      bertrand   23: #include "rpl-conv.h"
1.1       bertrand   24: 
                     25: 
                     26: /*
                     27: ================================================================================
1.60      bertrand   28:   Boucle principale de l'interprète RPL/2
1.1       bertrand   29: ================================================================================
1.60      bertrand   30:   Entrées : structure sur l'état du processus
1.1       bertrand   31: --------------------------------------------------------------------------------
1.60      bertrand   32:   Sorties : néant
1.1       bertrand   33: --------------------------------------------------------------------------------
1.60      bertrand   34:   Effets de bord : néant
1.1       bertrand   35: ================================================================================
                     36: */
                     37: 
                     38: logical1
                     39: sequenceur(struct_processus *s_etat_processus)
                     40: {
                     41:    struct_liste_chainee        *l_element_courant;
                     42: 
                     43:    struct_objet                *s_objet;
1.4       bertrand   44:    struct_objet                *s_objet_evaluation;
1.1       bertrand   45:    struct_objet                *s_sous_objet;
                     46: 
1.69      bertrand   47:    integer8                    niveau;
                     48:    integer8                    position_courante;
                     49: 
1.1       bertrand   50:    logical1                    drapeau_appel_definition;
                     51:    logical1                    drapeau_fin;
                     52:    logical1                    drapeau_then;
                     53:    logical1                    erreur;
1.56      bertrand   54:    logical1                    presence_compteur;
1.1       bertrand   55: 
                     56:    static logical1             completion_valide = d_faux;
                     57: 
                     58:    struct sigaction            action;
                     59:    struct sigaction            action_defaut;
                     60:    struct sigaction            action_defaut2;
                     61: 
                     62:    unsigned char               *instruction_majuscule;
                     63:    unsigned char               *ligne;
                     64:    unsigned char               *message;
                     65:    unsigned char               *registre;
                     66:    unsigned char               *tampon;
                     67:    unsigned char               *t_ligne;
                     68: 
1.49      bertrand   69:    Keymap                      ancien_keymap;
                     70:    Keymap                      nouveau_keymap;
                     71: 
1.1       bertrand   72:    (*s_etat_processus).retour_routine_evaluation = 'N';
                     73: 
                     74:    if ((*s_etat_processus).debug == d_vrai)
                     75:        if (((*s_etat_processus).type_debug &
                     76:                d_debug_appels_fonctions) != 0)
                     77:    {
                     78:        if ((*s_etat_processus).niveau_recursivite != 0)
                     79:        {
                     80:            if ((*s_etat_processus).langue == 'F')
                     81:            {
1.70      bertrand   82:                printf("[%d] Exécution récursive de niveau %lld\n",
1.1       bertrand   83:                        (int) getpid(), (*s_etat_processus).niveau_recursivite);
                     84:            }
                     85:            else
                     86:            {
1.70      bertrand   87:                printf("[%d] %lld level recursive execution\n",
1.1       bertrand   88:                        (int) getpid(), (*s_etat_processus).niveau_recursivite);
                     89:            }
                     90:        }
                     91:        else
                     92:        {
                     93:            if ((*s_etat_processus).langue == 'F')
                     94:            {
1.70      bertrand   95:                printf("[%d] Exécution\n", (int) getpid());
1.1       bertrand   96:            }
                     97:            else
                     98:            {
                     99:                printf("[%d] Execution\n", (int) getpid());
                    100:            }
                    101:        }
                    102: 
                    103:        fflush(stdout);
                    104:    }
                    105: 
                    106: /*
                    107: --------------------------------------------------------------------------------
1.60      bertrand  108:   Boucle de l'interprète RPL/2
1.1       bertrand  109:   On boucle tant qu'on n'a pas une bonne raison de sortir...
                    110: --------------------------------------------------------------------------------
                    111: */
                    112: 
                    113:    do
                    114:    {
                    115:        drapeau_appel_definition = d_faux;
                    116: 
                    117: /*
                    118: --------------------------------------------------------------------------------
1.60      bertrand  119:   Recherche de l'instruction suivante dans les définitions chaînées
1.1       bertrand  120: --------------------------------------------------------------------------------
                    121: */
                    122: 
                    123:        if ((erreur = recherche_instruction_suivante(s_etat_processus))
                    124:                == d_erreur)
                    125:        {
                    126:            return(d_erreur);
                    127:        }
                    128: 
                    129:        if (((*s_etat_processus).debug_programme == d_vrai) &&
                    130:                ((*s_etat_processus).niveau_recursivite == 0))
                    131:        {
                    132:            /*
                    133:             * Traitement de la commande HALT (debug)
                    134:             */
                    135: 
                    136:            action.sa_handler = SIG_IGN;
1.106   ! bertrand  137:            action.sa_flags = 0;
1.1       bertrand  138: 
                    139:            (*s_etat_processus).execution_pas_suivant = d_faux;
                    140:            (*s_etat_processus).traitement_instruction_halt = d_vrai;
                    141: 
                    142:            if (completion_valide == d_faux)
                    143:            {
                    144:                initialisation_completion();
                    145:                completion_valide = d_vrai;
                    146:            }
                    147: 
                    148:            while((*s_etat_processus).execution_pas_suivant == d_faux)
                    149:            {
                    150:                if ((*s_etat_processus).hauteur_pile_operationnelle != 0)
                    151:                {
                    152:                    fprintf(stdout, "\n");
                    153:                }
                    154: 
                    155:                affichage_pile(s_etat_processus, (*s_etat_processus)
                    156:                        .l_base_pile, 1);
                    157: 
                    158:                if ((*s_etat_processus).mode_interactif == 'N')
                    159:                {
                    160:                    printf("[%d] Instruction : %s\n", (int) getpid(),
                    161:                            (*s_etat_processus).instruction_courante);
                    162:                    fflush(stdout);
                    163:                }
                    164: 
                    165:                if (sigaction(SIGINT, &action, &action_defaut) != 0)
                    166:                {
                    167:                    (*s_etat_processus).erreur_systeme = d_es_signal;
                    168:                    return(d_erreur);
                    169:                }
                    170: 
                    171:                if (sigaction(SIGTSTP, &action, &action_defaut2) != 0)
                    172:                {
                    173:                    (*s_etat_processus).erreur_systeme = d_es_signal;
                    174:                    return(d_erreur);
                    175:                }
                    176: 
                    177:                (*s_etat_processus).var_volatile_requete_arret = 0;
                    178:                (*s_etat_processus).var_volatile_requete_arret2 = 0;
                    179: 
                    180:                flockfile(stdin);
                    181:                flockfile(stdout);
                    182: 
1.49      bertrand  183:                ancien_keymap = rl_get_keymap();
                    184:                nouveau_keymap = rl_copy_keymap(ancien_keymap);
                    185:                rl_set_keymap(nouveau_keymap);
                    186: 
1.50      bertrand  187:                rl_bind_key(NEWLINE, readline_analyse_syntaxique);
                    188:                rl_bind_key(RETURN, readline_analyse_syntaxique);
                    189:                rl_bind_key(CTRL('g'), readline_effacement);
1.49      bertrand  190:                rl_done = 0;
                    191: 
1.1       bertrand  192:                ligne = readline("RPL/2> ");
                    193: 
1.49      bertrand  194:                rl_set_keymap(ancien_keymap);
                    195:                rl_free(nouveau_keymap);
                    196: 
1.1       bertrand  197:                funlockfile(stdin);
                    198:                funlockfile(stdout);
                    199: 
                    200:                if (ligne != NULL)
                    201:                {
                    202:                    if ((t_ligne = transliteration(s_etat_processus, ligne,
                    203:                            (*s_etat_processus).localisation, d_locale))
                    204:                            == NULL)
                    205:                    {
1.27      bertrand  206:                        free((*s_etat_processus).instruction_courante);
1.1       bertrand  207:                        return(d_erreur);
                    208:                    }
                    209: 
                    210:                    free(ligne);
                    211:                    ligne = t_ligne;
                    212: 
1.85      bertrand  213:                    if ((ligne = compactage(s_etat_processus, ligne)) == NULL)
1.1       bertrand  214:                    {
                    215:                        (*s_etat_processus).erreur_systeme =
                    216:                                d_es_allocation_memoire;
                    217:                        return(d_erreur);
                    218:                    }
                    219:                }
                    220: 
                    221:                if (sigaction(SIGINT, &action_defaut, NULL) != 0)
                    222:                {
                    223:                    (*s_etat_processus).erreur_systeme = d_es_signal;
                    224:                    return(d_erreur);
                    225:                }
                    226: 
                    227:                if (sigaction(SIGTSTP, &action_defaut2, NULL) != 0)
                    228:                {
                    229:                    (*s_etat_processus).erreur_systeme = d_es_signal;
                    230:                    return(d_erreur);
                    231:                }
                    232: 
                    233:                if (ligne == NULL)
                    234:                {
                    235:                    if ((ligne = (unsigned char *) malloc(6 *
                    236:                            sizeof(unsigned char))) == NULL)
                    237:                    {
                    238:                        (*s_etat_processus).erreur_systeme =
                    239:                                d_es_allocation_memoire;
                    240:                        return(d_erreur);
                    241:                    }
                    242: 
                    243:                    sprintf(ligne, "abort");
                    244:                    fprintf(stdout, "%s\n", ligne);
                    245:                }
                    246:                else if (((*ligne) == d_code_fin_chaine) &&
                    247:                        ((*s_etat_processus).l_base_pile != NULL))
                    248:                {
                    249:                    free(ligne);
                    250: 
                    251:                    if ((ligne = (unsigned char *) malloc(4 *
                    252:                            sizeof(unsigned char))) == NULL)
                    253:                    {
                    254:                        (*s_etat_processus).erreur_systeme =
                    255:                                d_es_allocation_memoire;
                    256:                        return(d_erreur);
                    257:                    }
                    258: 
                    259:                    sprintf(ligne, "dup");
                    260:                }
                    261: 
1.85      bertrand  262:                if ((*s_etat_processus).var_volatile_requete_arret != 0)
                    263:                {
                    264:                    free(ligne);
                    265:                    (*s_etat_processus).requete_arret = 'Y';
                    266:                    break;
                    267:                }
                    268: 
1.1       bertrand  269:                add_history(ligne);
                    270:                stifle_history(ds_longueur_historique);
                    271: 
                    272:                position_courante = (*s_etat_processus).position_courante;
                    273:                tampon = (*s_etat_processus).definitions_chainees;
                    274:                registre = (*s_etat_processus).instruction_courante;
                    275:                (*s_etat_processus).definitions_chainees = ligne;
                    276: 
                    277:                if (analyse_syntaxique(s_etat_processus) == d_absence_erreur)
                    278:                {
                    279:                    (*s_etat_processus).instruction_courante = registre;
                    280:                    (*s_etat_processus).position_courante = position_courante;
                    281:                    (*s_etat_processus).definitions_chainees = tampon;
                    282: 
                    283:                    if ((tampon = (unsigned char *) malloc((strlen(ligne) + 7) *
                    284:                            sizeof(unsigned char))) == NULL)
                    285:                    {
                    286:                        (*s_etat_processus).erreur_systeme =
                    287:                                d_es_allocation_memoire;
                    288:                        return(d_erreur);
                    289:                    }
                    290: 
                    291:                    sprintf(tampon, "<< %s >>", ligne);
                    292: 
                    293:                    free(ligne);
                    294:                    ligne = tampon;
                    295: 
                    296:                    tampon = (*s_etat_processus).instruction_courante;
                    297:                    (*s_etat_processus).instruction_courante = ligne;
1.6       bertrand  298: 
1.82      bertrand  299:                    (*s_etat_processus).type_en_cours = NON;
1.1       bertrand  300:                    recherche_type(s_etat_processus);
                    301: 
1.6       bertrand  302:                    (*s_etat_processus).instruction_courante = tampon;
                    303: 
1.1       bertrand  304:                    if ((((*s_etat_processus).erreur_execution != d_ex) ||
                    305:                            ((*s_etat_processus).erreur_systeme != d_es)) &&
                    306:                            ((*s_etat_processus).invalidation_message_erreur
                    307:                            == d_faux))
                    308:                    {
                    309:                        if ((*s_etat_processus).erreur_execution != d_ex)
                    310:                        {
                    311:                            (*s_etat_processus).erreur_scrutation = d_vrai;
                    312:                        }
                    313: 
                    314:                        if (test_cfsf(s_etat_processus, 51) == d_faux)
                    315:                        {
                    316:                            printf("%s", ds_beep);
                    317:                        }
                    318: 
                    319:                        if ((message = messages(s_etat_processus)) == NULL)
                    320:                        {
1.27      bertrand  321:                            free((*s_etat_processus).instruction_courante);
1.1       bertrand  322:                            return(d_erreur);
                    323:                        }
                    324: 
                    325:                        printf("%s [%d]\n", message, (int) getpid());
                    326: 
                    327:                        free(message);
                    328: 
                    329:                        (*s_etat_processus).erreur_execution = d_ex;
                    330: 
                    331:                        if ((*s_etat_processus).erreur_systeme != d_es)
                    332:                        {
                    333:                            return(d_erreur);
                    334:                        }
                    335:                    }
                    336:                    else
                    337:                    {
1.76      bertrand  338:                        position_courante =
                    339:                                (*s_etat_processus).position_courante;
1.74      bertrand  340:                        empilement_pile_systeme(s_etat_processus);
                    341: 
                    342:                        if ((*s_etat_processus).erreur_systeme != d_es)
                    343:                        {
                    344:                            return(d_erreur);
                    345:                        }
                    346: 
1.1       bertrand  347:                        (*(*s_etat_processus).l_base_pile_systeme)
                    348:                                .retour_definition = 'Y';
                    349: 
                    350:                        if (depilement(s_etat_processus, &((*s_etat_processus)
                    351:                            .l_base_pile), &s_objet) == d_erreur)
                    352:                        {
                    353:                            if (test_cfsf(s_etat_processus, 51) == d_faux)
                    354:                            {
                    355:                                printf("%s", ds_beep);
                    356:                            }
                    357: 
                    358:                            if ((*s_etat_processus).langue == 'F')
                    359:                            {
1.70      bertrand  360:                                printf("+++Erreur : Défaut d'argument\n");
1.1       bertrand  361:                            }
                    362:                            else
                    363:                            {
                    364:                                printf("+++Error : Too few arguments\n");
                    365:                            }
                    366: 
1.74      bertrand  367:                            depilement_pile_systeme(s_etat_processus);
                    368: 
                    369:                            if ((*s_etat_processus).erreur_systeme != d_es)
                    370:                            {
                    371:                                return(d_erreur);
                    372:                            }
1.1       bertrand  373: 
                    374:                            fflush(stdout);
                    375:                        }
                    376:                        else if (evaluation(s_etat_processus, s_objet, 'I') ==
                    377:                                d_erreur)
                    378:                        {
                    379:                            if ((*s_etat_processus).erreur_systeme != d_es)
                    380:                            {
                    381:                                if (test_cfsf(s_etat_processus, 51) == d_faux)
                    382:                                {
                    383:                                    printf("%s", ds_beep);
                    384:                                }
                    385: 
                    386:                                if ((message = messages(s_etat_processus))
                    387:                                        == NULL)
                    388:                                {
1.27      bertrand  389:                                    free((*s_etat_processus)
                    390:                                            .instruction_courante);
1.1       bertrand  391:                                    return(d_erreur);
                    392:                                }
                    393: 
                    394:                                printf("%s [%d]\n", message, (int) getpid());
1.27      bertrand  395: 
1.1       bertrand  396:                                free(message);
1.27      bertrand  397:                                free((*s_etat_processus).instruction_courante);
1.1       bertrand  398:                                return(d_erreur);
                    399:                            }
                    400:                            else if ((*s_etat_processus)
                    401:                                    .invalidation_message_erreur == d_faux)
                    402:                            {
                    403:                                (*s_etat_processus).erreur_execution =
                    404:                                        (*s_etat_processus)
                    405:                                        .derniere_erreur_evaluation;
                    406: 
                    407:                                if (test_cfsf(s_etat_processus, 51) == d_faux)
                    408:                                {
                    409:                                    printf("%s", ds_beep);
                    410:                                }
                    411: 
                    412:                                if ((message = messages(s_etat_processus))
                    413:                                        == NULL)
                    414:                                {
1.27      bertrand  415:                                    free((*s_etat_processus)
                    416:                                            .instruction_courante);
1.1       bertrand  417:                                    return(d_erreur);
                    418:                                }
                    419: 
                    420:                                printf("%s [%d]\n", message, (int) getpid());
                    421:                                free(message);
                    422: 
                    423:                                if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    424:                                {
                    425:                                    l_element_courant = (*s_etat_processus)
                    426:                                            .l_base_pile_last;
                    427: 
                    428:                                    while(l_element_courant != NULL)
                    429:                                    {
                    430:                                        if ((s_sous_objet = copie_objet(
                    431:                                                s_etat_processus,
                    432:                                                (*l_element_courant).donnee,
                    433:                                                'P')) == NULL)
                    434:                                        {
                    435:                                            (*s_etat_processus).erreur_systeme =
                    436:                                                    d_es_allocation_memoire;
                    437:                                            return(d_erreur);
                    438:                                        }
                    439: 
                    440:                                        if (empilement(s_etat_processus,
                    441:                                                &((*s_etat_processus)
                    442:                                                .l_base_pile),
                    443:                                                s_sous_objet) == d_erreur)
                    444:                                        {
                    445:                                            return(d_erreur);
                    446:                                        }
                    447: 
                    448:                                        l_element_courant = (*l_element_courant)
                    449:                                                .suivant;
                    450:                                    }
                    451:                                }
                    452: 
                    453:                                (*s_etat_processus).erreur_execution = d_ex;
                    454:                                (*s_etat_processus).exception = d_ep;
                    455:                            }
                    456: 
                    457:                            liberation(s_etat_processus, s_objet);
                    458:                        }
                    459:                        else
                    460:                        {   
                    461:                            liberation(s_etat_processus, s_objet);
                    462:                        }
1.76      bertrand  463: 
                    464:                        (*s_etat_processus).position_courante =
                    465:                                position_courante;
1.1       bertrand  466:                    }
                    467:                }
                    468:                else if ((*s_etat_processus).invalidation_message_erreur
                    469:                        == d_faux)
                    470:                {
                    471:                    (*s_etat_processus).instruction_courante = registre;
                    472:                    (*s_etat_processus).position_courante = position_courante;
                    473:                    (*s_etat_processus).definitions_chainees = tampon;
                    474: 
                    475:                    if (test_cfsf(s_etat_processus, 51) == d_faux)
                    476:                    {
                    477:                        printf("%s", ds_beep);
                    478:                    }
                    479: 
                    480:                    if ((message = messages(s_etat_processus)) == NULL)
                    481:                    {
1.27      bertrand  482:                        free((*s_etat_processus).instruction_courante);
1.1       bertrand  483:                        free(ligne);
                    484:                        return(d_erreur);
                    485:                    }
                    486: 
                    487:                    free(message);
                    488: 
                    489:                    if ((*s_etat_processus).langue == 'F')
                    490:                    {
                    491:                        printf("+++Erreur : Erreur de syntaxe\n");
                    492:                    }
                    493:                    else
                    494:                    {
                    495:                        printf("+++Error : Syntax error\n");
                    496:                    }
                    497: 
                    498:                    fflush(stdout);
                    499:                }
                    500: 
                    501:                free(ligne);
                    502:            }
                    503: 
                    504:            (*s_etat_processus).traitement_instruction_halt = d_faux;
                    505:        }
                    506: 
                    507:        if ((*s_etat_processus).debug == d_vrai)
                    508:            if (((*s_etat_processus).type_debug &
                    509:                    d_debug_fonctions_intrinseques) != 0)
                    510:        {
                    511:            if ((*s_etat_processus).langue == 'F')
                    512:            {
                    513:                printf("[%d] Instruction %s\n",
                    514:                        (int) getpid(),
                    515:                        (*s_etat_processus).instruction_courante);
                    516:            }
                    517:            else
                    518:            {
                    519:                printf("[%d] %s instruction\n",
                    520:                        (int) getpid(),
                    521:                        (*s_etat_processus).instruction_courante);
                    522:            }
                    523: 
                    524:            fflush(stdout);
                    525:        }
                    526: 
                    527: /*
                    528: --------------------------------------------------------------------------------
1.60      bertrand  529:   Dans le cas où une instruction est retournée, celle-ci est évaluée. Dans le
                    530:   cas contraire, l'interprète renvoie un message d'erreur et s'interrompt.
1.1       bertrand  531: --------------------------------------------------------------------------------
                    532: */
                    533: 
                    534:        if (erreur == d_absence_erreur)
                    535:        {
                    536: 
                    537: /*
                    538: --------------------------------------------------------------------------------
1.60      bertrand  539:   Scrutation des mots clef du langage RPL/2 et exécution le cas échéant
                    540:   de l'action associée.
1.1       bertrand  541: --------------------------------------------------------------------------------
                    542: */
                    543: 
1.93      bertrand  544:            (*s_etat_processus).instruction_sensible = 'N';
1.99      bertrand  545: 
1.1       bertrand  546:            analyse(s_etat_processus, NULL);
                    547: 
                    548:            if ((*s_etat_processus).traitement_cycle_exit != 'N')
                    549:            {
                    550:                switch((*s_etat_processus).traitement_cycle_exit)
                    551:                {
                    552:                    case 'C' :
                    553:                    {
                    554:                        instruction_cycle(s_etat_processus);
                    555:                        break;
                    556:                    }
                    557: 
                    558:                    case 'E' :
                    559:                    {
                    560:                        instruction_exit(s_etat_processus);
                    561:                        break;
                    562:                    }
                    563:                }
                    564:            }
                    565: 
                    566:            if ((*s_etat_processus).instruction_valide == 'N')
                    567:            {
                    568:            
                    569: /*
                    570: --------------------------------------------------------------------------------
1.60      bertrand  571:   L'instruction ne correspond pas à l'un des mots clef du langage RPL/2.
1.1       bertrand  572: --------------------------------------------------------------------------------
                    573: */
                    574: 
                    575:                if ((recherche_variable(s_etat_processus,
                    576:                        (*s_etat_processus).instruction_courante) ==
                    577:                        d_vrai) && ((*s_etat_processus)
                    578:                        .autorisation_evaluation_nom == 'Y'))
                    579:                {
1.32      bertrand  580:                    if ((*(*s_etat_processus).pointeur_variable_courante)
                    581:                            .objet == NULL)
1.1       bertrand  582:                    {
                    583: 
                    584: /*
                    585: --------------------------------------------------------------------------------
1.60      bertrand  586:   L'instruction est une variable partagée
1.1       bertrand  587: --------------------------------------------------------------------------------
                    588: */
                    589: 
1.90      bertrand  590:                        if (recherche_variable_partagee(s_etat_processus,
                    591:                                (*(*s_etat_processus)
                    592:                                .pointeur_variable_courante).nom,
                    593:                                (*(*s_etat_processus)
                    594:                                .pointeur_variable_courante).variable_partagee,
                    595:                                'P') != NULL)
1.1       bertrand  596:                        {
1.90      bertrand  597:                            // La variable existe.
                    598: 
                    599:                            if ((*s_etat_processus).debug == d_vrai)
                    600:                                if (((*s_etat_processus).type_debug &
                    601:                                        d_debug_variables) != 0)
1.1       bertrand  602:                            {
1.90      bertrand  603:                                if ((*s_etat_processus).langue == 'F')
                    604:                                {
                    605:                                    printf("[%d] Évaluation de la variable "
1.60      bertrand  606:                                        "partagée %s de type %d\n",
1.32      bertrand  607:                                        (int) getpid(), (*s_etat_processus)
1.1       bertrand  608:                                        .instruction_courante,
1.32      bertrand  609:                                        (*(*(*s_etat_processus)
1.90      bertrand  610:                                        .pointeur_variable_partagee_courante)
                    611:                                        .objet).type);
                    612:                                }
                    613:                                else
                    614:                                {
                    615:                                    printf("[%d] Pushing %s as %d type shared "
1.70      bertrand  616:                                        "variable\n", (int) getpid(),
1.1       bertrand  617:                                        (*s_etat_processus)
                    618:                                        .instruction_courante,
1.32      bertrand  619:                                        (*(*(*s_etat_processus)
1.90      bertrand  620:                                        .pointeur_variable_partagee_courante)
                    621:                                        .objet).type);
                    622:                                }
                    623: 
                    624:                                fflush(stdout);
1.1       bertrand  625:                            }
                    626: 
                    627:                            if ((s_objet = copie_objet(s_etat_processus,
                    628:                                    (*(*s_etat_processus)
1.61      bertrand  629:                                    .pointeur_variable_partagee_courante)
                    630:                                    .objet, 'P')) == NULL)
1.1       bertrand  631:                            {
                    632:                                (*s_etat_processus).erreur_systeme =
                    633:                                        d_es_allocation_memoire;
                    634:                                return(d_erreur);
                    635:                            }
                    636: 
                    637:                            if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.61      bertrand  638:                                    .pointeur_variable_partagee_courante)
                    639:                                    .mutex)) != 0)
1.1       bertrand  640:                            {
                    641:                                (*s_etat_processus).erreur_systeme =
                    642:                                        d_es_processus;
                    643:                                return(d_erreur);
                    644:                            }
                    645: 
1.60      bertrand  646:                            if (evaluation(s_etat_processus, s_objet, 'E')
                    647:                                    == d_erreur)
1.1       bertrand  648:                            {
1.60      bertrand  649:                                liberation(s_etat_processus, s_objet);
1.1       bertrand  650:                                return(d_erreur);
                    651:                            }
1.60      bertrand  652: 
                    653:                            liberation(s_etat_processus, s_objet);
1.1       bertrand  654:                        }
                    655:                        else
                    656:                        {
                    657:                            // La variable n'existe plus.
1.90      bertrand  658:                            if ((*s_etat_processus).debug == d_vrai)
                    659:                                if (((*s_etat_processus).type_debug &
                    660:                                        d_debug_variables) != 0)
                    661:                            {
                    662:                                if ((*s_etat_processus).langue == 'F')
                    663:                                {
                    664:                                    printf("[%d] Tentative d'accès à la "
                    665:                                        "variable partagée non définie %s\n",
                    666:                                        (int) getpid(), (*s_etat_processus)
                    667:                                        .instruction_courante);
                    668:                                }
                    669:                                else
                    670:                                {
                    671:                                    printf("[%d] Trying to access to undefined "
                    672:                                        "shared variable %s\n",
                    673:                                        (int) getpid(),
                    674:                                        (*s_etat_processus)
                    675:                                        .instruction_courante);
                    676:                                }
                    677: 
                    678:                                fflush(stdout);
                    679:                            }
1.1       bertrand  680:                        }
                    681:                    }
                    682: 
                    683: /*
                    684: --------------------------------------------------------------------------------
1.60      bertrand  685:   L'instruction est une variable automatique (évaluation lors de l'empilement).
1.1       bertrand  686: --------------------------------------------------------------------------------
                    687: */
                    688: 
1.32      bertrand  689:                    else if ((*(*(*s_etat_processus).pointeur_variable_courante)
1.1       bertrand  690:                            .objet).type == ADR)
                    691:                    {
                    692: 
                    693: /*
                    694: --------------------------------------------------------------------------------
                    695:   L'instruction est une variable de type 'adresse' pointant sur une
1.60      bertrand  696:   définition. Un branchement est effectué à cette adresse.
1.1       bertrand  697: --------------------------------------------------------------------------------
                    698: */
                    699: 
                    700:                        if ((*s_etat_processus).debug == d_vrai)
                    701:                            if (((*s_etat_processus).type_debug &
                    702:                                    d_debug_appels_fonctions) != 0)
                    703:                        {
                    704:                            if ((*s_etat_processus).langue == 'F')
                    705:                            {
1.60      bertrand  706:                                printf("[%d] Branchement à la"
                    707:                                        " définition %s\n", (int) getpid(),
1.1       bertrand  708:                                        (*s_etat_processus)
                    709:                                        .instruction_courante);
                    710:                            }
                    711:                            else
                    712:                            {
                    713:                                printf("[%d] Execution : "
                    714:                                        "Branching at %s definition\n",
                    715:                                        (int) getpid(), (*s_etat_processus)
                    716:                                        .instruction_courante);
                    717:                            }
                    718: 
                    719:                            fflush(stdout);
                    720:                        }
                    721: 
                    722:                        (*s_etat_processus).autorisation_empilement_programme =
                    723:                                'N';
                    724: 
                    725:                        empilement_pile_systeme(s_etat_processus);
                    726: 
                    727:                        if ((*s_etat_processus).erreur_systeme != d_es)
                    728:                        {
                    729:                            erreur = d_erreur;
                    730:                        }
                    731:                        else
                    732:                        {
                    733:                            if ((*s_etat_processus).profilage == d_vrai)
                    734:                            {
                    735:                                profilage(s_etat_processus,
                    736:                                        (*s_etat_processus)
                    737:                                        .instruction_courante);
                    738: 
                    739:                                if ((*s_etat_processus).erreur_systeme != d_es)
                    740:                                {
                    741:                                    return(d_erreur);
                    742:                                }
                    743:                            }
                    744: 
1.104     bertrand  745:                            (*s_etat_processus).debug_programme = d_faux;
                    746: 
1.1       bertrand  747:                            (*(*s_etat_processus).l_base_pile_systeme)
                    748:                                    .adresse_retour = (*s_etat_processus)
                    749:                                    .position_courante;
                    750: 
                    751:                            (*(*s_etat_processus).l_base_pile_systeme)
                    752:                                    .retour_definition = 'Y';
                    753: 
                    754:                            (*(*s_etat_processus).l_base_pile_systeme)
                    755:                                    .niveau_courant = (*s_etat_processus)
                    756:                                    .niveau_courant;
                    757: 
                    758:                            (*s_etat_processus).position_courante =
1.69      bertrand  759:                                    (*((integer8 *)
1.32      bertrand  760:                                    ((*(*(*s_etat_processus)
                    761:                                    .pointeur_variable_courante)
                    762:                                    .objet).objet)));
1.1       bertrand  763: 
                    764:                            drapeau_appel_definition = d_vrai;
                    765:                        }
                    766:                    }
                    767:                    else
                    768:                    {
                    769:                        if ((*s_etat_processus).debug == d_vrai)
                    770:                            if (((*s_etat_processus).type_debug &
                    771:                                    d_debug_variables) != 0)
                    772:                        {
                    773:                            if ((*s_etat_processus).langue == 'F')
                    774:                            {
1.60      bertrand  775:                                printf("[%d] Évaluation de la variable "
1.1       bertrand  776:                                        "%s de type %d\n",
                    777:                                        (int) getpid(),
                    778:                                        (*s_etat_processus)
                    779:                                        .instruction_courante,
1.32      bertrand  780:                                        (*(*(*s_etat_processus)
                    781:                                        .pointeur_variable_courante).objet)
1.1       bertrand  782:                                        .type);
                    783:                            }
                    784:                            else
                    785:                            {
                    786:                                printf("[%d] Pushing %s as %d type variable "
                    787:                                        "\n", (int) getpid(),
                    788:                                        (*s_etat_processus)
                    789:                                        .instruction_courante,
1.32      bertrand  790:                                        (*(*(*s_etat_processus)
                    791:                                        .pointeur_variable_courante).objet)
1.1       bertrand  792:                                        .type);
                    793:                            }
                    794: 
                    795:                            fflush(stdout);
                    796:                        }
                    797: 
                    798:                        if ((s_objet = copie_objet(s_etat_processus,
1.32      bertrand  799:                                (*(*s_etat_processus)
                    800:                                .pointeur_variable_courante).objet, 'P'))
1.1       bertrand  801:                                == NULL)
                    802:                        {
                    803:                            (*s_etat_processus).erreur_systeme =
                    804:                                    d_es_allocation_memoire;
                    805:                            return(d_erreur);
                    806:                        }
                    807: 
1.60      bertrand  808:                        if (evaluation(s_etat_processus, s_objet, 'E')
                    809:                                == d_erreur)
1.1       bertrand  810:                        {
1.60      bertrand  811:                            liberation(s_etat_processus, s_objet);
1.1       bertrand  812:                            return(d_erreur);
                    813:                        }
1.60      bertrand  814: 
                    815:                        liberation(s_etat_processus, s_objet);
1.1       bertrand  816:                    }
                    817:                }
                    818:                else
                    819:                {
                    820: 
                    821: /*
                    822: --------------------------------------------------------------------------------
1.60      bertrand  823:   L'instruction est une donnée à empiler.
1.1       bertrand  824: --------------------------------------------------------------------------------
                    825: */
                    826: 
                    827:                    (*s_etat_processus).erreur_systeme = d_es;
1.82      bertrand  828:                    (*s_etat_processus).type_en_cours = NON;
1.1       bertrand  829:                    recherche_type(s_etat_processus);
1.4       bertrand  830: 
1.9       bertrand  831:                    if ((*s_etat_processus).autorisation_nom_implicite == 'N')
                    832:                    {
                    833:                        if ((*s_etat_processus).l_base_pile == NULL)
                    834:                        {
1.86      bertrand  835:                            if (((*s_etat_processus).erreur_execution !=
                    836:                                    d_ex_nom_implicite) &&
                    837:                                    ((*s_etat_processus).erreur_execution !=
                    838:                                    d_ex_syntaxe))
1.37      bertrand  839:                            {
                    840:                                (*s_etat_processus).erreur_execution =
                    841:                                        d_ex_manque_argument;
                    842:                            }
1.9       bertrand  843:                        }
1.12      bertrand  844:                        else if ((*(*(*s_etat_processus).l_base_pile).donnee)
                    845:                                .type == NOM)
1.9       bertrand  846:                        {
                    847:                            if ((*((struct_nom *) (*(*(*s_etat_processus)
                    848:                                    .l_base_pile).donnee).objet)).symbole
                    849:                                    == d_faux)
                    850:                            {
1.12      bertrand  851:                                (*s_etat_processus).erreur_execution =
                    852:                                        d_ex_nom_implicite;
                    853: 
1.60      bertrand  854:                                // Si le niveau de récursivité est non nul, on
1.12      bertrand  855:                                // arrive ici depuis la fonction
1.60      bertrand  856:                                // recherche_type(). On retourne à cette
                    857:                                // dernière en indiquant une erreur.
1.12      bertrand  858: 
                    859:                                if ((*s_etat_processus).niveau_recursivite != 0)
1.11      bertrand  860:                                {
1.12      bertrand  861:                                    free((*s_etat_processus)
                    862:                                            .instruction_courante);
1.11      bertrand  863:                                    return(d_erreur);
                    864:                                }
1.9       bertrand  865:                            }
                    866:                        }
                    867:                    }
                    868: 
1.60      bertrand  869:                    // Le séquenceur est appelé depuis la routine d'évaluation
1.4       bertrand  870: 
                    871:                    if ((*s_etat_processus).evaluation_forcee == 'Y')
                    872:                    {
                    873:                        if (depilement(s_etat_processus,
                    874:                                &((*s_etat_processus).l_base_pile),
                    875:                                &s_objet_evaluation) == d_erreur)
                    876:                        {
1.27      bertrand  877:                            free((*s_etat_processus).instruction_courante);
1.4       bertrand  878:                            (*s_etat_processus).erreur_execution =
                    879:                                    d_ex_manque_argument;
                    880:                            return(d_erreur);
                    881:                        }
                    882: 
                    883:                        if (evaluation(s_etat_processus, s_objet_evaluation,
                    884:                                'N') == d_erreur)
                    885:                        {
1.27      bertrand  886:                            free((*s_etat_processus).instruction_courante);
1.4       bertrand  887:                            liberation(s_etat_processus, s_objet_evaluation);
                    888:                            return(d_erreur);
                    889:                        }
                    890: 
                    891:                        liberation(s_etat_processus, s_objet_evaluation);
                    892:                    }
1.27      bertrand  893: 
1.60      bertrand  894:                    // Le séquenceur est appelé depuis la routine de
1.27      bertrand  895:                    // recherche de type
                    896: 
                    897:                    else if ((*s_etat_processus).recherche_type == 'Y')
                    898:                    {
                    899:                        if ((*s_etat_processus).erreur_execution != d_ex)
                    900:                        {
                    901:                            free((*s_etat_processus).instruction_courante);
                    902:                            return(d_erreur);
                    903:                        }
                    904:                    }
1.1       bertrand  905:                }
                    906:            }
                    907:            else if (((*s_etat_processus).test_instruction == 'Y') &&
                    908:                    ((*s_etat_processus).instruction_valide == 'Y'))
                    909:            {
                    910: 
                    911: /*
                    912: --------------------------------------------------------------------------------
                    913:   Permet de traiter les fonctions dans les objets de type liste
                    914: --------------------------------------------------------------------------------
                    915: */
                    916: 
                    917:                if ((instruction_majuscule = conversion_majuscule(
1.85      bertrand  918:                        s_etat_processus, (*s_etat_processus)
                    919:                        .instruction_courante)) == NULL)
1.1       bertrand  920:                {
                    921:                    (*s_etat_processus).erreur_systeme =
                    922:                            d_es_allocation_memoire;
                    923:                    return(d_erreur);
                    924:                }
                    925: 
                    926:                if ((strcmp((*s_etat_processus).instruction_courante, "<<")
                    927:                        != 0) && (strcmp((*s_etat_processus)
                    928:                        .instruction_courante, ">>") != 0))
                    929:                {
1.12      bertrand  930:                    if ((s_objet = allocation(s_etat_processus, FCT)) == NULL)
1.1       bertrand  931:                    {
                    932:                        (*s_etat_processus).erreur_systeme =
                    933:                                d_es_allocation_memoire;
                    934:                        return(d_erreur);
                    935:                    }
                    936: 
                    937:                    (*((struct_fonction *) (*s_objet).objet))
                    938:                            .nombre_arguments = 0;
                    939: 
1.93      bertrand  940:                    if (((*s_etat_processus).instruction_intrinseque == 'Y') &&
                    941:                            ((*s_etat_processus).instruction_sensible == 'N'))
1.1       bertrand  942:                    {
                    943:                        if (((*((struct_fonction *) (*s_objet).objet))
                    944:                                .nom_fonction = conversion_majuscule(
1.85      bertrand  945:                                s_etat_processus, (*s_etat_processus)
                    946:                                .instruction_courante)) == NULL)
1.1       bertrand  947:                        {
                    948:                            (*s_etat_processus).erreur_systeme =
                    949:                                    d_es_allocation_memoire;
                    950:                            return(d_erreur);
                    951:                        }
                    952:                    }
                    953:                    else
                    954:                    {
                    955:                        if (((*((struct_fonction *) (*s_objet).objet))
                    956:                                .nom_fonction = (unsigned char *) malloc(
                    957:                                (strlen((*s_etat_processus)
                    958:                                .instruction_courante)
                    959:                                + 1) * sizeof(unsigned char))) == NULL)
                    960:                        {
                    961:                            (*s_etat_processus).erreur_systeme =
                    962:                                    d_es_allocation_memoire;
                    963:                            return(d_erreur);
                    964:                        }
                    965: 
                    966:                        strcpy((*((struct_fonction *) (*s_objet).objet))
                    967:                                .nom_fonction, (*s_etat_processus)
                    968:                                .instruction_courante);
                    969:                    }
                    970: 
                    971:                    (*((struct_fonction *) (*s_objet).objet)).fonction =
                    972:                            analyse_instruction(s_etat_processus,
                    973:                            (*s_etat_processus).instruction_courante);
                    974: 
                    975:                    if (empilement(s_etat_processus,
                    976:                            &((*s_etat_processus).l_base_pile), s_objet) ==
                    977:                            d_erreur)
                    978:                    {
                    979:                        (*s_etat_processus).erreur_systeme =
                    980:                                d_es_allocation_memoire;
                    981:                        return(d_erreur);
                    982:                    }
                    983:                }
                    984:                else
                    985:                {
                    986:                    (*s_etat_processus).test_instruction = 'N';
                    987:                    analyse(s_etat_processus, NULL);
                    988:                    (*s_etat_processus).test_instruction = 'Y';
                    989:                }
                    990: 
                    991:                free(instruction_majuscule);
                    992:            }
                    993: 
1.69      bertrand  994:            erreur = (logical1) (erreur | (((*s_etat_processus)
                    995:                    .erreur_execution != d_ex) ? d_erreur : d_absence_erreur));
1.1       bertrand  996:        }
                    997:        else
                    998:        {
                    999:            printf("\n");
                   1000: 
                   1001:            if ((*s_etat_processus).langue == 'F')
                   1002:            {
                   1003:                printf("+++Erreur : Argument %s invalide\n",
                   1004:                        (*s_etat_processus).instruction_courante);
                   1005:            }
                   1006:            else
                   1007:            {
                   1008:                printf("+++Error : Invalid %s argument\n",
                   1009:                        (*s_etat_processus).instruction_courante);
                   1010:            }
                   1011: 
                   1012:            fflush(stdout);
                   1013: 
1.27      bertrand 1014:            free((*s_etat_processus).instruction_courante);
1.1       bertrand 1015:            return(d_erreur);
                   1016:        }
                   1017: 
                   1018: /*
                   1019: --------------------------------------------------------------------------------
1.60      bertrand 1020:   Traitement des arrêts simples
1.1       bertrand 1021: --------------------------------------------------------------------------------
                   1022: */
                   1023: 
                   1024:        if ((*s_etat_processus).var_volatile_requete_arret2 != 0)
                   1025:        {
                   1026:            if ((*s_etat_processus).debug_programme == d_vrai)
                   1027:            {
                   1028:                (*s_etat_processus).var_volatile_requete_arret2 = 0;
                   1029:            }
                   1030:            else
                   1031:            {
                   1032:                if ((*s_etat_processus).var_volatile_requete_arret2 == -1)
                   1033:                {
                   1034:                    if (strncmp(getenv("LANG"), "fr", 2) == 0)
                   1035:                    {
1.70      bertrand 1036:                        printf("[%d] Arrêt\n", (int) getpid());
1.1       bertrand 1037:                    }
                   1038:                    else
                   1039:                    {
                   1040:                        printf("[%d] Break\n", (int) getpid());
                   1041:                    }
                   1042: 
                   1043:                    (*s_etat_processus).var_volatile_requete_arret2 = 1;
                   1044: 
                   1045:                    fflush(stdout);
                   1046:                }
                   1047: 
                   1048:                if ((*s_etat_processus).niveau_recursivite == 0)
                   1049:                {
                   1050:                    (*s_etat_processus).debug_programme = d_vrai;
                   1051:                    (*s_etat_processus).var_volatile_requete_arret2 = 0;
                   1052:                }
                   1053:            }
                   1054:        }
                   1055: 
                   1056:        /*
                   1057:         * On ne sort pas du debugger en cas d'une erreur sur un programme
1.60      bertrand 1058:         * en cours de débogage.
1.1       bertrand 1059:         */
                   1060: 
                   1061:        if ((((*s_etat_processus).erreur_execution != d_ex) ||
                   1062:                ((*s_etat_processus).exception != d_ep)) &&
                   1063:                ((*s_etat_processus).debug_programme == d_vrai))
                   1064:        {
                   1065:            if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   1066:            {
                   1067:                l_element_courant = (*s_etat_processus).l_base_pile_last;
                   1068: 
                   1069:                while(l_element_courant != NULL)
                   1070:                {
                   1071:                    if ((s_objet = copie_objet(s_etat_processus,
                   1072:                            (*l_element_courant).donnee, 'P')) == NULL)
                   1073:                    {
                   1074:                        (*s_etat_processus).erreur_systeme =
                   1075:                                d_es_allocation_memoire;
                   1076:                        return(d_erreur);
                   1077:                    }
                   1078: 
                   1079:                    if (empilement(s_etat_processus, &((*s_etat_processus)
                   1080:                            .l_base_pile), s_objet) == d_erreur)
                   1081:                    {
                   1082:                        return(d_erreur);
                   1083:                    }
                   1084: 
                   1085:                    l_element_courant = (*l_element_courant).suivant;
                   1086:                }
                   1087:            }
                   1088: 
                   1089:            if (test_cfsf(s_etat_processus, 51) == d_faux)
                   1090:            {
                   1091:                printf("%s", ds_beep);
                   1092:            }
                   1093: 
                   1094:            if ((message = messages(s_etat_processus)) == NULL)
                   1095:            {
1.27      bertrand 1096:                free((*s_etat_processus).instruction_courante);
1.1       bertrand 1097:                return(d_erreur);
                   1098:            }
                   1099: 
                   1100:            printf("%s [%d]\n", message, (int) getpid());
                   1101: 
                   1102:            free(message);
                   1103: 
                   1104:            (*s_etat_processus).erreur_execution = d_ex;
                   1105:            (*s_etat_processus).exception = d_ep;
                   1106:            erreur = d_absence_erreur;
                   1107: 
1.69      bertrand 1108:            (*s_etat_processus).position_courante -= (integer8)
1.1       bertrand 1109:                    strlen((*s_etat_processus).instruction_courante);
                   1110:        }
                   1111: 
                   1112: /*
                   1113: --------------------------------------------------------------------------------
1.60      bertrand 1114:   Test de fin d'exécution du programme RPL/2
1.1       bertrand 1115: --------------------------------------------------------------------------------
                   1116: */
                   1117: 
                   1118:        if (((*s_etat_processus).niveau_courant == 0) &&
                   1119:                (drapeau_appel_definition != d_vrai))
                   1120:        {
                   1121:            drapeau_fin = d_vrai;
                   1122:        }
                   1123:        else if ((*s_etat_processus).requete_arret == 'Y')
                   1124:        {
                   1125:            drapeau_fin = d_vrai;
                   1126:        }
                   1127:        else if (((*s_etat_processus).var_volatile_requete_arret != 0)
                   1128:                && ((*s_etat_processus).debug_programme == d_faux))
                   1129:        {
                   1130:            drapeau_fin = d_vrai;
                   1131: 
                   1132:            if ((*s_etat_processus).erreur_systeme == d_es)
                   1133:            {
                   1134:                erreur = d_absence_erreur;
                   1135:            }
                   1136:        }
                   1137:        else if ((*s_etat_processus).arret_si_exception == d_vrai)
                   1138:        {
                   1139:            drapeau_fin = d_faux;
                   1140: 
                   1141:            if ((*s_etat_processus).exception != d_ep)
                   1142:            {
                   1143:                erreur = d_erreur;
                   1144:            }
                   1145:            else if ((*s_etat_processus).erreur_systeme != d_es)
                   1146:            {
                   1147:                erreur = d_erreur;
                   1148:            }
                   1149:        }
                   1150:        else if ((*s_etat_processus).arret_si_exception == d_faux)
                   1151:        {
                   1152:            if ((message = messages(s_etat_processus)) == NULL)
                   1153:            {
                   1154:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1155:                return(d_erreur);
                   1156:            }
                   1157: 
                   1158:            free(message);
                   1159: 
                   1160:            drapeau_fin = d_faux;
                   1161: 
                   1162: /*
                   1163: --------------------------------------------------------------------------------
                   1164:   Traitement des exceptions
                   1165: --------------------------------------------------------------------------------
                   1166: */
                   1167: 
                   1168:            if ((*s_etat_processus).erreur_systeme != d_es)
                   1169:            {
                   1170:                erreur = d_erreur;
                   1171:            }
                   1172:            else if (((*s_etat_processus).exception != d_ep) ||
                   1173:                    ((*s_etat_processus).erreur_execution != d_ex))
                   1174:            {
                   1175:                tampon = (*s_etat_processus).instruction_courante;
                   1176: 
                   1177:                while((*(*s_etat_processus).l_base_pile_systeme).clause != 'R')
                   1178:                {
                   1179:                    erreur = recherche_instruction_suivante(s_etat_processus);
                   1180: 
                   1181:                    if (erreur == d_erreur)
                   1182:                    {
1.27      bertrand 1183:                        free((*s_etat_processus).instruction_courante);
1.1       bertrand 1184:                        return(d_erreur);
                   1185:                    }
                   1186: 
                   1187:                    if (recherche_variable(s_etat_processus,
                   1188:                            (*s_etat_processus).instruction_courante) == d_vrai)
                   1189:                    {
1.32      bertrand 1190:                        if ((*(*s_etat_processus).pointeur_variable_courante)
                   1191:                                .objet == NULL)
1.1       bertrand 1192:                        {
1.60      bertrand 1193:                            // Variable partagée
1.1       bertrand 1194:                        }
1.32      bertrand 1195:                        else if ((*(*(*s_etat_processus)
                   1196:                                .pointeur_variable_courante).objet).type == ADR)
1.1       bertrand 1197:                        {
                   1198:                            empilement_pile_systeme(s_etat_processus);
                   1199: 
                   1200:                            if ((*s_etat_processus).erreur_systeme != d_es)
                   1201:                            {
1.27      bertrand 1202:                                free((*s_etat_processus).instruction_courante);
1.1       bertrand 1203:                                return(d_erreur);
                   1204:                            }
                   1205: 
                   1206:                            (*(*s_etat_processus).l_base_pile_systeme)
                   1207:                                    .adresse_retour = (*s_etat_processus)
                   1208:                                    .position_courante;
                   1209: 
                   1210:                            (*(*s_etat_processus).l_base_pile_systeme)
                   1211:                                    .retour_definition = 'Y';
                   1212: 
                   1213:                            (*(*s_etat_processus).l_base_pile_systeme)
                   1214:                                    .niveau_courant = (*s_etat_processus)
                   1215:                                    .niveau_courant;
                   1216: 
                   1217:                            (*s_etat_processus).position_courante =
1.69      bertrand 1218:                                    (*((integer8 *)
1.32      bertrand 1219:                                    ((*(*(*s_etat_processus)
                   1220:                                    .pointeur_variable_courante)
                   1221:                                    .objet).objet)));
1.1       bertrand 1222: 
                   1223:                            (*s_etat_processus)
                   1224:                                    .autorisation_empilement_programme = 'N';
                   1225:                        }
                   1226:                    }
                   1227:                    else
                   1228:                    {
                   1229:                        (*s_etat_processus).erreur_systeme = d_es;
                   1230:                        instruction_majuscule = conversion_majuscule(
1.85      bertrand 1231:                                s_etat_processus, (*s_etat_processus)
                   1232:                                .instruction_courante);
1.1       bertrand 1233: 
                   1234:                        if (instruction_majuscule == NULL)
                   1235:                        {
1.27      bertrand 1236:                            free((*s_etat_processus).instruction_courante);
1.1       bertrand 1237:                            return(d_erreur);
                   1238:                        }
                   1239: 
                   1240:                        /*
1.60      bertrand 1241:                         * Traitement de la pile système par les
                   1242:                         * différentes instructions.
1.1       bertrand 1243:                         */
                   1244: 
                   1245:                        if ((strcmp(instruction_majuscule, "IF") == 0) ||
                   1246:                                (strcmp(instruction_majuscule, "IFERR") == 0) ||
                   1247:                                (strcmp(instruction_majuscule, "DO") == 0) ||
                   1248:                                (strcmp(instruction_majuscule, "WHILE") == 0) ||
                   1249:                                (strcmp(instruction_majuscule, "FOR") == 0) ||
1.56      bertrand 1250:                                (strcmp(instruction_majuscule, "FORALL") == 0)
                   1251:                                ||
1.1       bertrand 1252:                                (strcmp(instruction_majuscule, "START") == 0) ||
                   1253:                                (strcmp(instruction_majuscule, "SELECT") == 0)
1.55      bertrand 1254:                                ||
                   1255:                                (strcmp(instruction_majuscule, "CRITICAL") == 0)
1.1       bertrand 1256:                                || (strcmp(instruction_majuscule, "CASE") == 0)
                   1257:                                || (strcmp(instruction_majuscule, "<<") == 0))
                   1258:                        {
                   1259:                            if (strcmp(instruction_majuscule, "<<") == 0)
                   1260:                            {
                   1261:                                analyse(s_etat_processus, NULL);
                   1262:                            }
1.56      bertrand 1263:                            else if ((strcmp(instruction_majuscule, "FOR") == 0)
1.57      bertrand 1264:                                    || (strcmp(instruction_majuscule, "FORALL")
                   1265:                                    == 0) || (strcmp(instruction_majuscule,
                   1266:                                    "START") == 0))
1.56      bertrand 1267:                            {
                   1268:                                empilement_pile_systeme(s_etat_processus);
                   1269: 
                   1270:                                if ((*s_etat_processus).erreur_systeme != d_es)
                   1271:                                {
                   1272:                                    return(d_erreur);
                   1273:                                }
                   1274: 
                   1275:                                (*(*s_etat_processus).l_base_pile_systeme)
                   1276:                                        .type_cloture = 'L';
                   1277:                            }
1.1       bertrand 1278:                            else
                   1279:                            {
                   1280:                                empilement_pile_systeme(s_etat_processus);
                   1281: 
                   1282:                                if ((*s_etat_processus).erreur_systeme != d_es)
                   1283:                                {
                   1284:                                    return(d_erreur);
                   1285:                                }
                   1286:                            }
                   1287:                        }
                   1288:                        else if ((strcmp(instruction_majuscule, "END") == 0) ||
                   1289:                                (strcmp(instruction_majuscule, "NEXT") == 0) ||
                   1290:                                (strcmp(instruction_majuscule, "STEP") == 0) ||
                   1291:                                (strcmp(instruction_majuscule, ">>") == 0))
                   1292:                        {
                   1293:                            if (strcmp(instruction_majuscule, ">>") == 0)
                   1294:                            {
                   1295:                                analyse(s_etat_processus, NULL);
                   1296: 
                   1297:                                if ((*(*s_etat_processus).l_base_pile_systeme)
                   1298:                                        .origine_routine_evaluation == 'Y')
                   1299:                                {
                   1300:                                    free(instruction_majuscule);
                   1301:                                    free((*s_etat_processus)
                   1302:                                            .instruction_courante);
                   1303: 
                   1304:                                    (*s_etat_processus).instruction_courante =
                   1305:                                            tampon;
                   1306: 
                   1307:                                    return(d_absence_erreur);
                   1308:                                }
                   1309:                            }
1.56      bertrand 1310:                            else if (((strcmp(instruction_majuscule, "NEXT")
                   1311:                                    == 0) || (strcmp(instruction_majuscule,
                   1312:                                    "STEP") == 0)) && ((*(*s_etat_processus)
                   1313:                                    .l_base_pile_systeme).type_cloture != 'L'))
                   1314:                            {
                   1315:                                /*
1.60      bertrand 1316:                                 * Libération des compteurs de boucle.
1.56      bertrand 1317:                                 */
                   1318: 
1.57      bertrand 1319:                                presence_compteur = (((*(*s_etat_processus)
                   1320:                                        .l_base_pile_systeme).type_cloture
                   1321:                                        == 'F') || ((*(*s_etat_processus)
1.56      bertrand 1322:                                        .l_base_pile_systeme).type_cloture
1.57      bertrand 1323:                                        == 'A')) ? d_vrai : d_faux;
1.56      bertrand 1324: 
                   1325:                                if (((*(*s_etat_processus).l_base_pile_systeme)
                   1326:                                        .type_cloture != 'S') &&
                   1327:                                        (presence_compteur == d_faux))
                   1328:                                {
                   1329:                                    return(d_erreur);
                   1330:                                }
                   1331: 
                   1332:                                if (presence_compteur == d_vrai)
                   1333:                                {
                   1334:                                    if (recherche_variable(s_etat_processus,
                   1335:                                            (*(*s_etat_processus)
                   1336:                                            .l_base_pile_systeme).nom_variable)
                   1337:                                            == d_faux)
                   1338:                                    {
                   1339:                                        return(d_erreur);
                   1340:                                    }
                   1341: 
                   1342:                                    if ((*(*s_etat_processus)
                   1343:                                            .pointeur_variable_courante).objet
                   1344:                                            == NULL)
                   1345:                                    {
                   1346:                                        return(d_erreur);
                   1347:                                    }
                   1348: 
                   1349:                                    (*s_etat_processus).niveau_courant--;
                   1350: 
1.59      bertrand 1351:                                    if (retrait_variables_par_niveau(
1.56      bertrand 1352:                                            s_etat_processus) == d_erreur)
                   1353:                                    {
                   1354:                                        return(d_erreur);
                   1355:                                    }
                   1356:                                }
                   1357: 
                   1358:                                depilement_pile_systeme(s_etat_processus);
                   1359: 
                   1360:                                if ((*s_etat_processus).erreur_systeme != d_es)
                   1361:                                {
                   1362:                                    return(d_erreur);
                   1363:                                }
                   1364:                            }
1.1       bertrand 1365:                            else
                   1366:                            {
1.60      bertrand 1367:                                // Traitement spécifique pour la fin
1.55      bertrand 1368:                                // d'une section critique
                   1369: 
                   1370:                                if ((*s_etat_processus).l_base_pile_systeme
                   1371:                                        == NULL)
                   1372:                                {
                   1373:                                    (*s_etat_processus).erreur_systeme =
                   1374:                                            d_es_processus;
                   1375:                                    return(d_erreur);
                   1376:                                }
                   1377: 
                   1378:                                if ((*(*s_etat_processus).l_base_pile_systeme)
                   1379:                                        .type_cloture == 'Q')
                   1380:                                {
                   1381:                                    if (pthread_mutex_unlock(
                   1382:                                            &mutex_sections_critiques) != 0)
                   1383:                                    {
                   1384:                                        (*s_etat_processus).erreur_systeme =
                   1385:                                                d_es_processus;
                   1386:                                        return(d_erreur);
                   1387:                                    }
                   1388: 
                   1389:                                    (*s_etat_processus).sections_critiques--;
                   1390:                                }
                   1391: 
1.1       bertrand 1392:                                depilement_pile_systeme(s_etat_processus);
                   1393: 
                   1394:                                if ((*s_etat_processus).erreur_systeme != d_es)
                   1395:                                {
                   1396:                                    return(d_erreur);
                   1397:                                }
                   1398:                            }
                   1399:                        }
                   1400: 
                   1401:                        free(instruction_majuscule);
                   1402:                    }
                   1403: 
                   1404:                    free((*s_etat_processus).instruction_courante);
                   1405:                }
                   1406: 
                   1407:                drapeau_then = d_faux;
                   1408:                niveau = 0;
                   1409: 
                   1410:                do
                   1411:                {
                   1412:                    erreur = recherche_instruction_suivante(s_etat_processus);
                   1413: 
                   1414:                    if (erreur == d_erreur)
                   1415:                    {
                   1416:                        return(d_erreur);
                   1417:                    }
                   1418:                    
                   1419:                    instruction_majuscule = conversion_majuscule(
1.85      bertrand 1420:                            s_etat_processus,
1.1       bertrand 1421:                            (*s_etat_processus).instruction_courante);
                   1422: 
                   1423:                    if (instruction_majuscule == NULL)
                   1424:                    {
                   1425:                        return(d_erreur);
                   1426:                    }
                   1427: 
                   1428:                    if ((strcmp(instruction_majuscule, "IF") == 0) ||
                   1429:                            (strcmp(instruction_majuscule, "IFERR") == 0) ||
                   1430:                            (strcmp(instruction_majuscule, "DO") == 0) ||
                   1431:                            (strcmp(instruction_majuscule, "WHILE") == 0) ||
                   1432:                            (strcmp(instruction_majuscule, "FOR") == 0) ||
1.56      bertrand 1433:                            (strcmp(instruction_majuscule, "FORALL") == 0) ||
1.1       bertrand 1434:                            (strcmp(instruction_majuscule, "START") == 0) ||
                   1435:                            (strcmp(instruction_majuscule, "SELECT") == 0)
1.55      bertrand 1436:                            || (strcmp(instruction_majuscule, "CRITICAL") == 0)
1.1       bertrand 1437:                            || (strcmp(instruction_majuscule, "CASE") == 0)
                   1438:                            || (strcmp(instruction_majuscule, "<<") == 0))
                   1439:                    {
                   1440:                        niveau++;
                   1441:                    }
                   1442:                    else if ((strcmp(instruction_majuscule, "END") == 0) ||
                   1443:                            (strcmp(instruction_majuscule, "NEXT") == 0) ||
                   1444:                            (strcmp(instruction_majuscule, "STEP") == 0) ||
                   1445:                            (strcmp(instruction_majuscule, ">>") == 0))
                   1446:                    {
                   1447:                        niveau--;
                   1448:                    }
                   1449: 
                   1450:                    drapeau_then = ((strcmp(instruction_majuscule, "THEN") == 0)
                   1451:                            && (niveau == 0)) ? d_vrai : d_faux;
                   1452: 
                   1453:                    free(instruction_majuscule);
                   1454:                    free((*s_etat_processus).instruction_courante);
                   1455:                } while(drapeau_then == d_faux);
                   1456: 
                   1457:                (*s_etat_processus).position_courante -= 5;
                   1458:                (*s_etat_processus).instruction_courante = tampon;
                   1459:                (*(*s_etat_processus).l_base_pile_systeme).clause = 'X';
                   1460: 
                   1461:                erreur = d_absence_erreur;
                   1462:                (*s_etat_processus).exception = d_ep;
                   1463:                (*s_etat_processus).erreur_execution = d_ex;
                   1464:            }
                   1465:        }
                   1466:        else
                   1467:        {
                   1468:            drapeau_fin = d_faux;
                   1469:        }
                   1470: 
                   1471:        if (erreur == d_absence_erreur)
                   1472:        {
                   1473:            free((*s_etat_processus).instruction_courante);
                   1474:        }
                   1475:    } while((erreur == d_absence_erreur) &&
                   1476:            ((*s_etat_processus).position_courante <
                   1477:            (*s_etat_processus).longueur_definitions_chainees) &&
                   1478:            (drapeau_fin == d_faux) &&
                   1479:            ((*s_etat_processus).retour_routine_evaluation == 'N'));
                   1480: 
                   1481: /*
                   1482: --------------------------------------------------------------------------------
1.60      bertrand 1483:   Messages d'erreur à afficher le cas échéant
1.1       bertrand 1484: --------------------------------------------------------------------------------
                   1485: */
                   1486: 
                   1487:    if ((erreur != d_absence_erreur) && ((*s_etat_processus)
                   1488:            .invalidation_message_erreur == d_faux))
                   1489:    {
                   1490:        if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   1491:        {
                   1492:            l_element_courant = (*s_etat_processus).l_base_pile_last;
                   1493: 
                   1494:            while(l_element_courant != NULL)
                   1495:            {
                   1496:                if ((s_objet = copie_objet(s_etat_processus,
                   1497:                        (*l_element_courant).donnee, 'P')) == NULL)
                   1498:                {
                   1499:                    (*s_etat_processus).erreur_systeme =
                   1500:                            d_es_allocation_memoire;
                   1501:                    return(d_erreur);
                   1502:                }
                   1503: 
                   1504:                if (empilement(s_etat_processus, &((*s_etat_processus)
                   1505:                        .l_base_pile), s_objet) == d_erreur)
                   1506:                {
                   1507:                    return(d_erreur);
                   1508:                }
                   1509: 
                   1510:                l_element_courant = (*l_element_courant).suivant;
                   1511:            }
                   1512:        }
                   1513: 
                   1514:        if (test_cfsf(s_etat_processus, 51) == d_faux)
                   1515:        {
                   1516:            printf("%s", ds_beep);
                   1517:        }
                   1518: 
                   1519:        if ((message = messages(s_etat_processus)) == NULL)
                   1520:        {
                   1521:            return(d_erreur);
                   1522:        }
                   1523: 
                   1524:        printf("%s [%d]\n", message, (int) getpid());
                   1525: 
                   1526:        free(message);
                   1527:        free((*s_etat_processus).instruction_courante);
                   1528: 
                   1529:        if ((*s_etat_processus).var_volatile_processus_pere == 0)
                   1530:        {
1.43      bertrand 1531:            envoi_signal_processus((*s_etat_processus).pid_processus_pere,
1.95      bertrand 1532:                    rpl_sigalrm, d_faux);
1.1       bertrand 1533:        }
                   1534:        else
                   1535:        {
                   1536:            (*s_etat_processus).var_volatile_alarme = -1;
                   1537:        }
                   1538: 
                   1539:        return(d_erreur);
                   1540:    }
                   1541: 
                   1542:    return(d_absence_erreur);
                   1543: }
                   1544: 
                   1545: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>