Annotation of rpl/src/instructions_f1.c, revision 1.49

1.1       bertrand    1: /*
                      2: ================================================================================
1.49    ! bertrand    3:   RPL/2 (R) version 4.1.12
1.35      bertrand    4:   Copyright (C) 1989-2012 Dr. BERTRAND Joël
1.1       bertrand    5: 
                      6:   This file is part of RPL/2.
                      7: 
                      8:   RPL/2 is free software; you can redistribute it and/or modify it
                      9:   under the terms of the CeCILL V2 License as published by the french
                     10:   CEA, CNRS and INRIA.
                     11:  
                     12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
                     13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
                     14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
                     15:   for more details.
                     16:  
                     17:   You should have received a copy of the CeCILL License
                     18:   along with RPL/2. If not, write to info@cecill.info.
                     19: ================================================================================
                     20: */
                     21: 
                     22: 
1.15      bertrand   23: #include "rpl-conv.h"
1.1       bertrand   24: 
                     25: 
                     26: /*
                     27: ================================================================================
                     28:   Fonction '->'
                     29: ================================================================================
                     30:   Entrées : structure processus
                     31: --------------------------------------------------------------------------------
                     32:   Sorties :
                     33: --------------------------------------------------------------------------------
                     34:   Effets de bord : néant
                     35: ================================================================================
                     36: */
                     37: 
                     38: void
                     39: instruction_fleche(struct_processus *s_etat_processus)
                     40: {
                     41:    struct_liste_chainee                *l_element_courant;
                     42:    struct_liste_chainee                *l_emplacement_valeurs;
                     43: 
                     44:    struct_objet                        *s_objet;
                     45:    struct_objet                        *s_objet_elementaire;
                     46:    struct_objet                        *s_expression_algebrique;
                     47: 
                     48:    struct_variable                     s_variable;
                     49: 
                     50:    struct_variable_partagee            s_variable_partagee;
                     51:    struct_variable_statique            s_variable_statique;
                     52: 
                     53:    logical1                            fin_scrutation;
                     54:    logical1                            presence_expression_algebrique;
                     55: 
                     56:    union_position_variable             position_variable;
                     57: 
                     58:    unsigned char                       instruction_valide;
                     59:    unsigned char                       *tampon;
                     60:    unsigned char                       test_instruction;
                     61: 
                     62:    unsigned long                       i;
                     63:    unsigned long                       nombre_variables;
                     64: 
                     65:    void                                (*fonction)();
                     66: 
                     67:    (*s_etat_processus).erreur_execution = d_ex;
                     68: 
                     69:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     70:    {
                     71:        printf("\n  -> ");
                     72: 
                     73:        if ((*s_etat_processus).langue == 'F')
                     74:        {
                     75:            printf("(création de variables locales)\n\n");
                     76:        }
                     77:        else
                     78:        {
                     79:            printf("(create local variables)\n\n");
                     80:        }
                     81: 
                     82:        printf("    n: %s, %s, %s, %s, %s, %s,\n"
                     83:                "       %s, %s, %s, %s, %s,\n"
                     84:                "       %s, %s, %s, %s, %s,\n"
                     85:                "       %s, %s, %s, %s,\n"
                     86:                "       %s, %s\n",
                     87:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                     88:                d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
                     89:                d_SQL, d_SLB, d_PRC, d_MTX);
                     90:        printf("    ...\n");
                     91:        printf("    1: %s, %s, %s, %s, %s, %s,\n"
                     92:                "       %s, %s, %s, %s, %s,\n"
                     93:                "       %s, %s, %s, %s, %s,\n"
                     94:                "       %s, %s, %s, %s,\n"
                     95:                "       %s, %s\n",
                     96:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                     97:                d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SCK,
                     98:                d_SQL, d_SLB, d_PRC, d_MTX);
                     99: 
                    100:        if ((*s_etat_processus).langue == 'F')
                    101:        {
                    102:            printf("  Utilisation :\n\n");
                    103:        }
                    104:        else
                    105:        {
                    106:            printf("  Usage:\n\n");
                    107:        }
                    108: 
                    109:        printf("    -> (variables) %s\n\n", d_RPN);
                    110: 
                    111:        printf("    -> (variables) %s\n", d_ALG);
                    112: 
                    113:        return;
                    114:    }
                    115:    else if ((*s_etat_processus).test_instruction == 'Y')
                    116:    {
                    117:        (*s_etat_processus).nombre_arguments = -1;
                    118:        return;
                    119:    }
                    120: 
                    121:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    122:    {
                    123:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                    124:        {
                    125:            return;
                    126:        }
                    127:    }
                    128: 
                    129:    (*s_etat_processus).autorisation_empilement_programme = 'N';
                    130: 
                    131: /*
                    132: --------------------------------------------------------------------------------
                    133:   Boucler jusqu'au prochain '<<' ou jusqu'à la prochaine expression algébrique
                    134: --------------------------------------------------------------------------------
                    135: */
                    136: 
                    137:    test_instruction = (*s_etat_processus).test_instruction;
                    138:    instruction_valide = (*s_etat_processus).instruction_valide;
                    139:    presence_expression_algebrique = d_faux;
                    140: 
                    141:    if ((*s_etat_processus).debug == d_vrai)
                    142:        if (((*s_etat_processus).type_debug &
                    143:                d_debug_variables) != 0)
                    144:    {
                    145:        if ((*s_etat_processus).langue == 'F')
                    146:        {
                    147:            printf("[%d] Recherche des variables locales\n", (int) getpid());
                    148:        }
                    149:        else
                    150:        {
                    151:            printf("[%d] Searching for local variables\n", (int) getpid());
                    152:        }
                    153: 
                    154:        fflush(stdout);
                    155:    }
                    156: 
                    157:    nombre_variables = 0;
                    158: 
                    159:    if ((*s_etat_processus).mode_execution_programme == 'Y')
                    160:    {
                    161:        /*
                    162:         * Le programme est exécuté normalement.
                    163:         */
                    164: 
                    165:        tampon = (*s_etat_processus).instruction_courante;
                    166: 
                    167:        do
                    168:        {
                    169:            if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
                    170:            {
                    171:                (*s_etat_processus).instruction_courante = tampon;
                    172:                return;
                    173:            }
                    174: 
                    175:            if (strcmp((*s_etat_processus).instruction_courante, "<<") == 0)
                    176:            {
                    177:                fin_scrutation = d_vrai;
                    178:                (*s_etat_processus).test_instruction = 'N';
                    179:            }
                    180:            else
                    181:            {
                    182:                fin_scrutation = d_faux;
                    183:                (*s_etat_processus).test_instruction = 'Y';
                    184:            }
                    185: 
                    186:            analyse(s_etat_processus, NULL);
                    187: 
                    188:            if ((*s_etat_processus).instruction_valide == 'N')
                    189:            {
                    190:                recherche_type(s_etat_processus);
                    191: 
                    192:                if ((*s_etat_processus).erreur_execution != d_ex)
                    193:                {
                    194:                    (*s_etat_processus).instruction_courante = tampon;
                    195:                    return;
                    196:                }
                    197:                
                    198:                if ((*(*(*s_etat_processus).l_base_pile).donnee).type == ALG)
                    199:                {
                    200:                    (*s_etat_processus).niveau_courant++;
                    201:                    fin_scrutation = d_vrai;
                    202:                    presence_expression_algebrique = d_vrai;
                    203: 
                    204:                    if (depilement(s_etat_processus, &((*s_etat_processus)
                    205:                            .l_base_pile), &s_expression_algebrique)
                    206:                            == d_erreur)
                    207:                    {
                    208:                        (*s_etat_processus).erreur_execution =
                    209:                                d_ex_manque_argument;
                    210:                        (*s_etat_processus).instruction_courante = tampon;
                    211:                        return;
                    212:                    }
                    213:                }
                    214:                else if ((*(*(*s_etat_processus).l_base_pile).donnee)
                    215:                        .type != NOM)
                    216:                {
                    217:                    (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
                    218:                    (*s_etat_processus).instruction_courante = tampon;
                    219:                    return;
                    220:                }
                    221:                else if ((*((struct_nom *) (*(*(*s_etat_processus).l_base_pile)
                    222:                        .donnee).objet)).symbole == d_vrai)
                    223:                {
                    224:                    (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
                    225:                    (*s_etat_processus).instruction_courante = tampon;
                    226:                    return;
                    227:                }
                    228:                else
                    229:                {
                    230:                    nombre_variables = nombre_variables + 1;
                    231:                }
                    232:            }
                    233:            else
                    234:            {
                    235:                if (fin_scrutation == d_faux)
                    236:                {
                    237:                    (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
                    238:                    (*s_etat_processus).instruction_courante = tampon;
                    239:                    return;
                    240:                }
                    241:            }
                    242: 
                    243:            free((*s_etat_processus).instruction_courante);
                    244:        } while(fin_scrutation == d_faux);
                    245: 
                    246:        (*s_etat_processus).instruction_courante = tampon;
                    247:    }
                    248:    else
                    249:    {
                    250:        /*
                    251:         * Une expression est en cours d'évaluation.
                    252:         */
                    253: 
                    254:        l_element_courant = (*(*s_etat_processus).expression_courante).suivant;
                    255:        tampon = (*s_etat_processus).instruction_courante;
                    256: 
                    257:        do
                    258:        {
                    259:            if ((*(*l_element_courant).donnee).type == FCT)
                    260:            {
                    261:                fonction = (*((struct_fonction *) (*(*l_element_courant)
                    262:                        .donnee).objet)).fonction;
                    263: 
                    264:                if (fonction == instruction_vers_niveau_superieur)
                    265:                {
                    266:                    fin_scrutation = d_vrai;
                    267:                    (*s_etat_processus).test_instruction = 'N';
                    268: 
                    269:                    analyse(s_etat_processus,
                    270:                            instruction_vers_niveau_superieur);
                    271:                }
                    272:                else
                    273:                {
1.9       bertrand  274:                    (*s_etat_processus).expression_courante = l_element_courant;
1.1       bertrand  275:                    (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
                    276:                    return;
                    277:                }
                    278:            }
                    279:            else if ((*(*l_element_courant).donnee).type == ALG)
                    280:            {
                    281:                (*s_etat_processus).niveau_courant++;
                    282:                fin_scrutation = d_vrai;
                    283:                presence_expression_algebrique = d_vrai;
                    284: 
                    285:                s_expression_algebrique = (*l_element_courant).donnee;
                    286:            }
                    287:            else if ((*(*l_element_courant).donnee).type != NOM)
                    288:            {
1.9       bertrand  289:                (*s_etat_processus).expression_courante = l_element_courant;
1.1       bertrand  290:                (*s_etat_processus).erreur_execution = d_ex_nom_invalide;
                    291:                return;
                    292:            }
                    293:            else
                    294:            {
                    295:                if ((s_objet_elementaire = copie_objet(s_etat_processus,
                    296:                        (*l_element_courant).donnee, 'P')) == NULL)
                    297:                {
1.9       bertrand  298:                    (*s_etat_processus).expression_courante = l_element_courant;
1.1       bertrand  299:                    (*s_etat_processus).erreur_systeme =
                    300:                            d_es_allocation_memoire;
                    301:                    return;
                    302:                }
                    303: 
                    304:                if (empilement(s_etat_processus, &((*s_etat_processus)
                    305:                        .l_base_pile), s_objet_elementaire) == d_erreur)
                    306:                {
1.9       bertrand  307:                    (*s_etat_processus).expression_courante = l_element_courant;
1.1       bertrand  308:                    return;
                    309:                }
                    310: 
                    311:                nombre_variables = nombre_variables + 1;
                    312:                fin_scrutation = d_faux;
                    313:            }
                    314: 
                    315:            (*s_etat_processus).expression_courante = l_element_courant;
                    316:            l_element_courant = (*l_element_courant).suivant;
                    317:        } while((fin_scrutation == d_faux) && (l_element_courant != NULL));
                    318: 
1.9       bertrand  319:        (*s_etat_processus).objet_courant =
                    320:                (*(*s_etat_processus).expression_courante).donnee;
1.1       bertrand  321:        (*s_etat_processus).instruction_courante = tampon;
                    322: 
                    323:        if (fin_scrutation == d_faux)
                    324:        {
                    325:            (*s_etat_processus).erreur_execution = d_ex_erreur_evaluation;
                    326:            return;
                    327:        }
                    328:    }
                    329: 
                    330:    if (nombre_variables < 1)
                    331:    {
                    332:        (*s_etat_processus).erreur_execution = d_ex_absence_variable;
                    333:        return;
                    334:    }
                    335: 
                    336:    if ((*s_etat_processus).debug == d_vrai)
                    337:        if (((*s_etat_processus).type_debug &
                    338:                d_debug_variables) != 0)
                    339:    {
                    340:        if ((*s_etat_processus).langue == 'F')
                    341:        {
                    342:            printf("[%d] Nombre de variables de niveau %lu : %lu\n",
                    343:                    (int) getpid(),
                    344:                    (*s_etat_processus).niveau_courant, nombre_variables);
                    345:        }
                    346:        else
                    347:        {
                    348:            printf("[%d] Number of level %lu variables : %lu\n",
                    349:                    (int) getpid(),
                    350:                    (*s_etat_processus).niveau_courant, nombre_variables);
                    351:        }
                    352: 
                    353:        fflush(stdout);
                    354:    }
                    355: 
                    356:    l_emplacement_valeurs = (*s_etat_processus).l_base_pile;
                    357: 
                    358:    for(i = 0; i < nombre_variables; i++)
                    359:    {
1.11      bertrand  360:        if (l_emplacement_valeurs == NULL)
                    361:        {
                    362:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    363:            return;
                    364:        }
                    365: 
1.1       bertrand  366:        l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;
                    367:    }
                    368: 
                    369:    l_element_courant = l_emplacement_valeurs;
                    370: 
                    371:    for(i = 0; i < nombre_variables; i++)
                    372:    {
                    373:        if (l_element_courant == NULL)
                    374:        {
                    375:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    376:            return;
                    377:        }
                    378: 
                    379:        l_element_courant = (*l_element_courant).suivant;
                    380:    }
                    381: 
                    382:    for(i = 0; i < nombre_variables; i++)
                    383:    {
                    384:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    385:                &s_objet) == d_erreur)
                    386:        {
                    387:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    388:            return;
                    389:        }
                    390: 
                    391:        if ((s_variable.nom = malloc((strlen(
                    392:                (*((struct_nom *) (*s_objet).objet)).nom) + 1) *
                    393:                sizeof(unsigned char))) == NULL)
                    394:        {
                    395:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    396:            return;
                    397:        }
                    398: 
                    399:        strcpy(s_variable.nom, (*((struct_nom *) (*s_objet).objet)).nom);
                    400: 
                    401:        if ((*s_etat_processus).debug == d_vrai)
                    402:            if (((*s_etat_processus).type_debug &
                    403:                    d_debug_variables) != 0)
                    404:        {
                    405:            printf("[%d] Variable %s\n", (int) getpid(), s_variable.nom);
                    406:            fflush(stdout);
                    407:        }
                    408: 
                    409:        s_variable.niveau = (*s_etat_processus).niveau_courant;
                    410: 
                    411:        // Si le drapeau creation_variables_statiques est positionné,
                    412:        // on recherche une entrée dans la table des variables statiques.
                    413:        // Si cette entrée existe, on affecte à la variable créée l'objet
                    414:        // contenu dans la table des variables statiques. Dans le cas contraire,
                    415:        // on crée une entrée dans la table des variables statiques avec
                    416:        // ce qui se trouve dans la pile.
                    417: 
                    418:        if ((*s_etat_processus).l_base_pile_systeme == NULL)
                    419:        {
                    420:            (*s_etat_processus).erreur_systeme = d_es_pile_vide;
                    421:            return;
                    422:        }
                    423: 
                    424:        /*
                    425:         * Vérification de l'unicité de la variable pour un niveau donné
                    426:         */
                    427: 
                    428:        if (recherche_variable(s_etat_processus, s_variable.nom) == d_vrai)
                    429:        {
                    430:            if ((*s_etat_processus).niveau_courant ==
1.23      bertrand  431:                    (*(*s_etat_processus).pointeur_variable_courante).niveau)
1.1       bertrand  432:            {
                    433:                liberation(s_etat_processus, s_objet);
                    434:                free(s_variable.nom);
                    435: 
                    436:                (*s_etat_processus).erreur_execution = d_ex_creation_variable;
                    437:                return;
                    438:            }
                    439:        }
                    440: 
                    441:        (*s_etat_processus).erreur_systeme = d_es;
                    442: 
                    443:        if ((*(*s_etat_processus).l_base_pile_systeme)
                    444:                .creation_variables_statiques == d_vrai)
                    445:        {
                    446:            if ((*s_etat_processus).mode_execution_programme == 'Y')
                    447:            {
                    448:                position_variable.adresse =
                    449:                        (*s_etat_processus).position_courante;
                    450:            }
                    451:            else
                    452:            {
                    453:                position_variable.pointeur =
                    454:                        (*s_etat_processus).objet_courant;
                    455:            }
                    456: 
                    457:            if (recherche_variable_statique(s_etat_processus, s_variable.nom,
                    458:                    position_variable,
                    459:                    ((*s_etat_processus).mode_execution_programme == 'Y')
1.43      bertrand  460:                    ? 'P' : 'E') != NULL)
1.1       bertrand  461:            {
                    462:                // Variable statique à utiliser
                    463: 
                    464:                if ((*s_etat_processus).mode_execution_programme == 'Y')
                    465:                {
                    466:                    s_variable.origine = 'P';
                    467:                }
                    468:                else
                    469:                {
                    470:                    s_variable.origine = 'E';
                    471:                }
                    472: 
1.43      bertrand  473:                s_variable.objet = (*(*s_etat_processus)
                    474:                        .pointeur_variable_statique_courante).objet;
                    475:                (*(*s_etat_processus).pointeur_variable_statique_courante)
                    476:                        .objet = NULL;
1.1       bertrand  477:            }
                    478:            else
                    479:            {
                    480:                // Variable statique à créer
                    481: 
                    482:                s_variable_statique.objet = NULL;
                    483:                (*s_etat_processus).erreur_systeme = d_es;
                    484: 
                    485:                if ((s_variable_statique.nom = malloc((strlen(s_variable.nom)
                    486:                        + 1) * sizeof(unsigned char))) == NULL)
                    487:                {
                    488:                    (*s_etat_processus).erreur_systeme =
                    489:                            d_es_allocation_memoire;
                    490:                    return;
                    491:                }
                    492: 
                    493:                strcpy(s_variable_statique.nom, s_variable.nom);
                    494: 
                    495:                if ((*s_etat_processus).mode_execution_programme == 'Y')
                    496:                {
                    497:                    s_variable_statique.origine = 'P';
                    498:                    s_variable_statique.niveau = 0;
                    499:                    s_variable_statique.variable_statique.adresse =
                    500:                            (*s_etat_processus).position_courante;
                    501:                }
                    502:                else
                    503:                {
                    504:                    s_variable_statique.origine = 'E';
                    505: 
                    506:                    /*
                    507:                     * Si la variable est appelée depuis une expression
                    508:                     * compilée (variable de niveau 0), la variable statique
                    509:                     * est persistante (niveau 0). Dans le cas contraire, elle
                    510:                     * est persistante à l'expression (niveau courant).
                    511:                     */
                    512: 
                    513:                    if ((*s_etat_processus).evaluation_expression_compilee
                    514:                            == 'Y')
                    515:                    {
                    516:                        s_variable_statique.niveau = 0;
                    517:                    }
                    518:                    else
                    519:                    {
                    520:                        s_variable_statique.niveau =
                    521:                                (*s_etat_processus).niveau_courant;
                    522:                    }
                    523: 
                    524:                    s_variable_statique.variable_statique.pointeur =
                    525:                            (*s_etat_processus).objet_courant;
                    526:                }
                    527: 
                    528:                if (creation_variable_statique(s_etat_processus,
                    529:                        &s_variable_statique) == d_erreur)
                    530:                {
                    531:                    return;
                    532:                }
                    533: 
                    534:                s_variable.objet = (*l_emplacement_valeurs).donnee;
                    535:                (*l_emplacement_valeurs).donnee = NULL;
                    536:            }
                    537:        }
                    538:        else if ((*(*s_etat_processus).l_base_pile_systeme)
                    539:                .creation_variables_partagees == d_vrai)
                    540:        {
                    541:            if ((*s_etat_processus).mode_execution_programme == 'Y')
                    542:            {
                    543:                position_variable.adresse =
                    544:                        (*s_etat_processus).position_courante;
                    545:            }
                    546:            else
                    547:            {
                    548:                position_variable.pointeur =
                    549:                        (*s_etat_processus).objet_courant;
                    550:            }
                    551: 
1.48      bertrand  552:            if (pthread_mutex_lock(&mutex_creation_variable_partagee) != 0)
                    553:            {
                    554:                (*s_etat_processus).erreur_systeme = d_es_processus;
                    555:                return;
                    556:            }
                    557: 
1.1       bertrand  558:            if (recherche_variable_partagee(s_etat_processus, s_variable.nom,
                    559:                    position_variable,
                    560:                    ((*s_etat_processus).mode_execution_programme == 'Y')
1.47      bertrand  561:                    ? 'P' : 'E') != NULL)
1.1       bertrand  562:            {
                    563:                // Variable partagée à utiliser
                    564: 
1.48      bertrand  565:                if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
                    566:                        != 0)
                    567:                {
                    568:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                    569:                    return;
                    570:                }
                    571: 
1.1       bertrand  572:                if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.46      bertrand  573:                        .pointeur_variable_partagee_courante).mutex)) != 0)
1.1       bertrand  574:                {
                    575:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                    576:                    return;
                    577:                }
                    578: 
                    579:                // Les champs niveau, variable_statique, variable_partagee
                    580:                // et variable_verrouillee sont renseignés lors de l'appel
                    581:                // à la fonction creation_variable().
                    582: 
                    583:                if ((*s_etat_processus).mode_execution_programme == 'Y')
                    584:                {
                    585:                    s_variable.origine = 'P';
                    586:                }
                    587:                else
                    588:                {
                    589:                    s_variable.origine = 'E';
                    590:                }
                    591: 
                    592:                s_variable.objet = NULL;
                    593:            }
                    594:            else
                    595:            {
                    596:                // Variable partagee à créer
                    597: 
                    598:                (*s_etat_processus).erreur_systeme = d_es;
                    599: 
                    600:                if ((s_variable_partagee.nom = malloc((strlen(s_variable.nom)
                    601:                        + 1) * sizeof(unsigned char))) == NULL)
                    602:                {
1.8       bertrand  603:                    if (pthread_mutex_unlock(&((*(*s_etat_processus)
1.46      bertrand  604:                            .pointeur_variable_partagee_courante).mutex)) != 0)
1.8       bertrand  605:                    {
                    606:                        (*s_etat_processus).erreur_systeme = d_es_processus;
                    607:                        return;
                    608:                    }
                    609: 
1.1       bertrand  610:                    (*s_etat_processus).erreur_systeme =
                    611:                            d_es_allocation_memoire;
                    612:                    return;
                    613:                }
                    614: 
                    615:                strcpy(s_variable_partagee.nom, s_variable.nom);
                    616: 
                    617:                if ((*s_etat_processus).mode_execution_programme == 'Y')
                    618:                {
                    619:                    s_variable_partagee.origine = 'P';
                    620:                    s_variable_partagee.niveau = 0;
                    621:                    s_variable_partagee.variable_partagee.adresse =
                    622:                            (*s_etat_processus).position_courante;
                    623:                }
                    624:                else
                    625:                {
                    626:                    s_variable_partagee.origine = 'E';
                    627: 
                    628:                    /*
                    629:                     * Si la variable est appelée depuis une expression
                    630:                     * compilée (variable de niveau 0), la variable statique
                    631:                     * est persistante (niveau 0). Dans le cas contraire, elle
                    632:                     * est persistante à l'expression (niveau courant).
                    633:                     */
                    634: 
                    635:                    if ((*s_etat_processus).evaluation_expression_compilee
                    636:                            == 'Y')
                    637:                    {
                    638:                        s_variable_partagee.niveau = 0;
                    639:                    }
                    640:                    else
                    641:                    {
                    642:                        s_variable_partagee.niveau =
                    643:                                (*s_etat_processus).niveau_courant;
                    644:                    }
                    645: 
                    646:                    s_variable_partagee.variable_partagee.pointeur =
                    647:                            (*s_etat_processus).objet_courant;
                    648:                }
                    649: 
                    650:                s_variable_partagee.objet = (*l_emplacement_valeurs).donnee;
                    651:                (*l_emplacement_valeurs).donnee = NULL;
                    652: 
                    653:                if (creation_variable_partagee(s_etat_processus,
                    654:                        &s_variable_partagee) == d_erreur)
                    655:                {
                    656:                    return;
                    657:                }
                    658: 
1.48      bertrand  659:                s_variable.objet = NULL;
                    660: 
                    661:                if (pthread_mutex_unlock(&mutex_creation_variable_partagee)
                    662:                        != 0)
1.1       bertrand  663:                {
                    664:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                    665:                    return;
                    666:                }
                    667:            }
                    668:        }
                    669:        else
                    670:        {
                    671:            s_variable.objet = (*l_emplacement_valeurs).donnee;
                    672:            (*l_emplacement_valeurs).donnee = NULL;
                    673:        }
                    674: 
                    675:        l_emplacement_valeurs = (*l_emplacement_valeurs).suivant;
                    676: 
                    677:        if (creation_variable(s_etat_processus, &s_variable,
                    678:                ((*(*s_etat_processus).l_base_pile_systeme)
                    679:                .creation_variables_statiques == d_vrai) ? 'S' : 'V',
                    680:                ((*(*s_etat_processus).l_base_pile_systeme)
                    681:                .creation_variables_partagees == d_vrai) ? 'S' : 'P')
                    682:                == d_erreur)
                    683:        {
                    684:            return;
                    685:        }
                    686: 
                    687:        liberation(s_etat_processus, s_objet);
                    688:    }
                    689: 
                    690:    // Les prochaines variables créées seront forcément du type volatile et
                    691:    // seront obligatoirement privées.
                    692: 
                    693:    if ((*s_etat_processus).l_base_pile_systeme == NULL)
                    694:    {
                    695:        (*s_etat_processus).erreur_systeme = d_es_pile_vide;
                    696:        return;
                    697:    }
                    698: 
                    699:    (*(*s_etat_processus).l_base_pile_systeme).creation_variables_statiques
                    700:            = d_faux;
                    701:    (*(*s_etat_processus).l_base_pile_systeme).creation_variables_partagees
                    702:            = d_faux;
                    703: 
                    704:    for(i = 0; i < nombre_variables; i++)
                    705:    {
                    706:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    707:                &s_objet) == d_erreur)
                    708:        {
                    709:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    710:            return;
                    711:        }
                    712: 
                    713:        liberation(s_etat_processus, s_objet);
                    714:    }
                    715: 
                    716:    (*s_etat_processus).test_instruction = test_instruction;
                    717:    (*s_etat_processus).instruction_valide = instruction_valide;
                    718: 
                    719:    /*
                    720:     * Traitement le cas échéant de l'expression algébrique
                    721:     */
                    722: 
                    723:    if (presence_expression_algebrique == d_vrai)
                    724:    {
                    725:        evaluation(s_etat_processus, s_expression_algebrique, 'N');
                    726: 
                    727:        if ((*s_etat_processus).mode_execution_programme == 'Y')
                    728:        {
                    729:            liberation(s_etat_processus, s_expression_algebrique);
                    730:        }
                    731: 
                    732:        (*s_etat_processus).niveau_courant--;
                    733: 
1.43      bertrand  734:        if (retrait_variables_par_niveau(s_etat_processus) == d_erreur)
1.1       bertrand  735:        {
                    736:            return;
                    737:        }
                    738: 
                    739:        (*s_etat_processus).autorisation_empilement_programme = 'Y';
                    740:    }
                    741: 
                    742:    return;
                    743: }
                    744: 
                    745: 
                    746: /*
                    747: ================================================================================
                    748:   Fonction '->list'
                    749: ================================================================================
                    750:   Entrées : structure processus
                    751: --------------------------------------------------------------------------------
                    752:   Sorties :
                    753: --------------------------------------------------------------------------------
                    754:   Effets de bord : néant
                    755: ================================================================================
                    756: */
                    757: 
                    758: void
                    759: instruction_fleche_list(struct_processus *s_etat_processus)
                    760: {
                    761:    struct_liste_chainee            *l_element_courant;
                    762: 
                    763:    struct_objet                    *s_objet;
                    764: 
                    765:    signed long                     i;
                    766:    signed long                     nombre_elements;
                    767: 
                    768:     (*s_etat_processus).erreur_execution = d_ex;
                    769: 
                    770:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    771:    {
                    772:        printf("\n  ->LIST ");
                    773: 
                    774:        if ((*s_etat_processus).langue == 'F')
                    775:        {
                    776:            printf("(création d'une liste)\n\n");
                    777:        }
                    778:        else
                    779:        {
                    780:            printf("(create list)\n\n");
                    781:        }
                    782: 
                    783:        printf("    n: %s, %s, %s, %s, %s, %s,\n"
                    784:                "       %s, %s, %s, %s, %s,\n"
                    785:                "       %s, %s, %s, %s, %s,\n"
                    786:                "       %s, %s\n",
                    787:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                    788:                d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
                    789:        printf("    ...\n");
                    790:        printf("    2: %s, %s, %s, %s, %s, %s,\n"
                    791:                "       %s, %s, %s, %s, %s,\n"
                    792:                "       %s, %s, %s, %s, %s,\n"
                    793:                "       %s, %s\n",
                    794:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                    795:                d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
                    796:        printf("    1: %s\n", d_INT);
                    797:        printf("->  1: %s\n", d_LST);
                    798: 
                    799:        return;
                    800:    }
                    801:    else if ((*s_etat_processus).test_instruction == 'Y')
                    802:    {
                    803:        (*s_etat_processus).nombre_arguments = -1;
                    804:        return;
                    805:    }
                    806: 
                    807:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    808:    {
                    809:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                    810:        {
                    811:            return;
                    812:        }
                    813:    }
                    814: 
                    815:    if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
                    816:    {
                    817:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    818:        return;
                    819:    }
                    820: 
                    821:    if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
                    822:    {
                    823:        (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    824:        return;
                    825:    }
                    826: 
                    827:    nombre_elements = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
                    828:            .donnee).objet));
                    829: 
                    830:    if (nombre_elements < 0)
                    831:    {
                    832: 
                    833: /*
                    834: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
                    835: */
                    836: 
                    837:        (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    838:        return;
                    839:    }
                    840: 
                    841:    if ((unsigned long) nombre_elements >=
                    842:            (*s_etat_processus).hauteur_pile_operationnelle)
                    843:    {
                    844:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    845:        return;
                    846:    }
                    847: 
                    848:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    849:    {
                    850:        if (empilement_pile_last(s_etat_processus, nombre_elements + 1)
                    851:                == d_erreur)
                    852:        {
                    853:            return;
                    854:        }
                    855:    }
                    856: 
                    857:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    858:            &s_objet) == d_erreur)
                    859:    {
                    860:        return;
                    861:    }
                    862: 
                    863:    liberation(s_etat_processus, s_objet);
                    864:    l_element_courant = NULL;
                    865: 
                    866:    for(i = 0; i < nombre_elements; i++)
                    867:    {
                    868:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    869:                &s_objet) == d_erreur)
                    870:        {
                    871:            return;
                    872:        }
                    873: 
                    874:        if (empilement(s_etat_processus, &l_element_courant, s_objet)
                    875:                == d_erreur)
                    876:        {
                    877:            return;
                    878:        }
                    879:    }
                    880: 
                    881:    if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
                    882:    {
                    883:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    884:        return;
                    885:    }
                    886: 
                    887:    (*s_objet).objet = (void *) l_element_courant;
                    888: 
                    889:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    890:            s_objet) == d_erreur)
                    891:    {
                    892:        return;
                    893:    }
                    894: 
                    895:     return;
                    896: }
                    897: 
                    898: 
                    899: /*
                    900: ================================================================================
                    901:   Fonction 'for'
                    902: ================================================================================
                    903:   Entrées : structure processus
                    904: --------------------------------------------------------------------------------
                    905:   Sorties :
                    906: --------------------------------------------------------------------------------
                    907:   Effets de bord : néant
                    908: ================================================================================
                    909: */
                    910: 
                    911: void
                    912: instruction_for(struct_processus *s_etat_processus)
                    913: {
                    914:    struct_objet                        *s_objet_1;
                    915:    struct_objet                        *s_objet_2;
                    916:    struct_objet                        *s_objet_3;
                    917: 
                    918:    struct_variable                     s_variable;
                    919: 
                    920:    unsigned char                       instruction_valide;
                    921:    unsigned char                       *tampon;
                    922:    unsigned char                       test_instruction;
                    923: 
                    924:     (*s_etat_processus).erreur_execution = d_ex;
                    925: 
                    926:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    927:    {
                    928:        printf("\n  FOR ");
                    929: 
                    930:        if ((*s_etat_processus).langue == 'F')
                    931:        {
                    932:            printf("(boucle définie avec compteur)\n\n");
                    933:        }
                    934:        else
                    935:        {
                    936:            printf("(define a counter-based loop)\n\n");
                    937:        }
                    938: 
                    939:        if ((*s_etat_processus).langue == 'F')
                    940:        {
                    941:            printf("  Utilisation :\n\n");
                    942:        }
                    943:        else
                    944:        {
                    945:            printf("  Usage:\n\n");
                    946:        }
                    947: 
                    948:        printf("    %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
                    949:                d_INT, d_REL);
                    950:        printf("        (expression)\n");
                    951:        printf("        [EXIT]/[CYCLE]\n");
                    952:        printf("        ...\n");
                    953:        printf("    NEXT\n\n");
                    954: 
                    955:        printf("    %s/%s %s/%s FOR (variable)\n", d_INT, d_REL,
                    956:                d_INT, d_REL);
                    957:        printf("        (expression)\n");
                    958:        printf("        [EXIT]/[CYCLE]\n");
                    959:        printf("        ...\n");
                    960:        printf("    %s/%s STEP\n", d_INT, d_REL);
                    961: 
                    962:        return;
                    963:    }
                    964:    else if ((*s_etat_processus).test_instruction == 'Y')
                    965:    {
                    966:        (*s_etat_processus).nombre_arguments = -1;
                    967:        return;
                    968:    }
                    969: 
                    970:    if ((*s_etat_processus).erreur_systeme != d_es)
                    971:    {
                    972:        return;
                    973:    }
                    974: 
                    975:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    976:    {
                    977:        if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
                    978:        {
                    979:            return;
                    980:        }
                    981:    }
                    982: 
                    983:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    984:            &s_objet_1) == d_erreur)
                    985:    {
                    986:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    987:        return;
                    988:    }
                    989: 
                    990:    if (((*s_objet_1).type != INT) &&
                    991:            ((*s_objet_1).type != REL))
                    992:    {
                    993:        liberation(s_etat_processus, s_objet_1);
                    994: 
                    995:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                    996:        return;
                    997:    }
                    998: 
                    999:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1000:            &s_objet_2) == d_erreur)
                   1001:    {
                   1002:        liberation(s_etat_processus, s_objet_1);
                   1003: 
                   1004:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1005:        return;
                   1006:    }
                   1007: 
                   1008:    if (((*s_objet_2).type != INT) &&
                   1009:            ((*s_objet_2).type != REL))
                   1010:    {
                   1011:        liberation(s_etat_processus, s_objet_1);
                   1012:        liberation(s_etat_processus, s_objet_2);
                   1013: 
                   1014:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                   1015:        return;
                   1016:    }
                   1017: 
                   1018:    tampon = (*s_etat_processus).instruction_courante;
                   1019:    test_instruction = (*s_etat_processus).test_instruction;
                   1020:    instruction_valide = (*s_etat_processus).instruction_valide;
                   1021:    (*s_etat_processus).test_instruction = 'Y';
                   1022: 
1.41      bertrand 1023:    empilement_pile_systeme(s_etat_processus);
                   1024: 
                   1025:    if ((*s_etat_processus).erreur_systeme != d_es)
                   1026:    {
                   1027:        return;
                   1028:    }
                   1029: 
1.1       bertrand 1030:    if ((*s_etat_processus).mode_execution_programme == 'Y')
                   1031:    {
                   1032:        if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
                   1033:        {
                   1034:            return;
                   1035:        }
                   1036: 
                   1037:        analyse(s_etat_processus, NULL);
                   1038: 
                   1039:        if ((*s_etat_processus).instruction_valide == 'Y')
                   1040:        {
                   1041:            liberation(s_etat_processus, s_objet_1);
                   1042:            liberation(s_etat_processus, s_objet_2);
                   1043: 
                   1044:            free((*s_etat_processus).instruction_courante);
                   1045:            (*s_etat_processus).instruction_courante = tampon;
                   1046: 
1.41      bertrand 1047:            depilement_pile_systeme(s_etat_processus);
                   1048: 
1.1       bertrand 1049:            (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
                   1050:            return;
                   1051:        }
                   1052: 
                   1053:        recherche_type(s_etat_processus);
                   1054: 
                   1055:        free((*s_etat_processus).instruction_courante);
                   1056:        (*s_etat_processus).instruction_courante = tampon;
                   1057: 
                   1058:        if ((*s_etat_processus).erreur_execution != d_ex)
                   1059:        {
                   1060:            liberation(s_etat_processus, s_objet_1);
                   1061:            liberation(s_etat_processus, s_objet_2);
                   1062: 
1.41      bertrand 1063:            depilement_pile_systeme(s_etat_processus);
1.1       bertrand 1064:            return;
                   1065:        }
                   1066: 
                   1067:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1068:                &s_objet_3) == d_erreur)
                   1069:        {
                   1070:            liberation(s_etat_processus, s_objet_1);
                   1071:            liberation(s_etat_processus, s_objet_2);
                   1072: 
1.41      bertrand 1073:            depilement_pile_systeme(s_etat_processus);
                   1074: 
1.1       bertrand 1075:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1076:            return;
                   1077:        }
                   1078: 
                   1079:        (*(*s_etat_processus).l_base_pile_systeme)
                   1080:                .origine_routine_evaluation = 'N';
                   1081:    }
                   1082:    else
                   1083:    {
                   1084:        if ((*s_etat_processus).expression_courante == NULL)
                   1085:        {
1.41      bertrand 1086:            depilement_pile_systeme(s_etat_processus);
1.1       bertrand 1087:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1088:            return;
                   1089:        }
                   1090: 
                   1091:        (*s_etat_processus).expression_courante = (*(*s_etat_processus)
                   1092:                .expression_courante).suivant;
                   1093: 
                   1094:        if ((s_objet_3 = copie_objet(s_etat_processus,
                   1095:                (*(*s_etat_processus).expression_courante)
                   1096:                .donnee, 'P')) == NULL)
                   1097:        {
                   1098:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1099:            return;
                   1100:        }
                   1101: 
                   1102:        (*(*s_etat_processus).l_base_pile_systeme)
                   1103:                .origine_routine_evaluation = 'Y';
                   1104:    }
                   1105: 
                   1106:    if ((*s_objet_3).type != NOM)
                   1107:    {
                   1108:        liberation(s_etat_processus, s_objet_1);
                   1109:        liberation(s_etat_processus, s_objet_2);
                   1110: 
1.41      bertrand 1111:        depilement_pile_systeme(s_etat_processus);
                   1112: 
1.1       bertrand 1113:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                   1114:        return;
                   1115:    }
                   1116:    else if ((*((struct_nom *) (*s_objet_3).objet)).symbole == d_vrai)
                   1117:    {
                   1118:        liberation(s_etat_processus, s_objet_1);
                   1119:        liberation(s_etat_processus, s_objet_2);
                   1120: 
1.41      bertrand 1121:        depilement_pile_systeme(s_etat_processus);
                   1122: 
1.1       bertrand 1123:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                   1124:        return;
                   1125:    }
                   1126: 
                   1127:    (*s_etat_processus).niveau_courant++;
                   1128: 
                   1129:    if ((s_variable.nom = malloc((strlen(
                   1130:            (*((struct_nom *) (*s_objet_3).objet)).nom) + 1) *
                   1131:            sizeof(unsigned char))) == NULL)
                   1132:    {
                   1133:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1134:        return;
                   1135:    }
                   1136: 
                   1137:    strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_3).objet)).nom);
                   1138:    s_variable.niveau = (*s_etat_processus).niveau_courant;
                   1139:    s_variable.objet = s_objet_2;
                   1140: 
                   1141:    if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') == d_erreur)
                   1142:    {
                   1143:        return;
                   1144:    }
                   1145: 
                   1146:    liberation(s_etat_processus, s_objet_3);
                   1147: 
                   1148:    (*s_etat_processus).test_instruction = test_instruction;
                   1149:    (*s_etat_processus).instruction_valide = instruction_valide;
                   1150: 
                   1151:    (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
                   1152: 
                   1153:    if ((*s_etat_processus).mode_execution_programme == 'Y')
                   1154:    {
                   1155:        (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
                   1156:                (*s_etat_processus).position_courante;
                   1157:    }
                   1158:    else
                   1159:    {
                   1160:        (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
                   1161:                (*s_etat_processus).expression_courante;
                   1162:    }
                   1163: 
                   1164:    (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'F';
                   1165: 
                   1166:    if (((*(*s_etat_processus).l_base_pile_systeme).nom_variable =
                   1167:            malloc((strlen(s_variable.nom) + 1) *
                   1168:            sizeof(unsigned char))) == NULL)
                   1169:    {
                   1170:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1171:        return;
                   1172:    }
                   1173: 
                   1174:    strcpy((*(*s_etat_processus).l_base_pile_systeme).nom_variable,
                   1175:            s_variable.nom);
                   1176: 
                   1177:    return;
                   1178: }
                   1179: 
                   1180: 
                   1181: /*
                   1182: ================================================================================
                   1183:   Fonction 'fc?'
                   1184: ================================================================================
                   1185:   Entrées : structure processus
                   1186: --------------------------------------------------------------------------------
                   1187:   Sorties :
                   1188: --------------------------------------------------------------------------------
                   1189:   Effets de bord : néant
                   1190: ================================================================================
                   1191: */
                   1192: 
                   1193: void
                   1194: instruction_fc_test(struct_processus *s_etat_processus)
                   1195: {
                   1196:    struct_objet                *s_objet_argument;
                   1197:    struct_objet                *s_objet_resultat;
                   1198: 
                   1199:     (*s_etat_processus).erreur_execution = d_ex;
                   1200: 
                   1201:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1202:    {
                   1203:        printf("\n  FC? ");
                   1204: 
                   1205:        if ((*s_etat_processus).langue == 'F')
                   1206:        {
                   1207:            printf("(teste si un drapeau est désarmé)\n\n");
                   1208:        }
                   1209:        else
                   1210:        {
                   1211:            printf("(test if flag is clear)\n\n");
                   1212:        }
                   1213: 
                   1214:        printf("    1: %s\n", d_INT);
                   1215:        printf("->  1: %s\n", d_INT);
                   1216: 
                   1217:        return;
                   1218:    }
                   1219:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1220:    {
                   1221:        (*s_etat_processus).nombre_arguments = -1;
                   1222:        return;
                   1223:    }
                   1224:    
                   1225:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   1226:    {
                   1227:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   1228:        {
                   1229:            return;
                   1230:        }
                   1231:    }
                   1232: 
                   1233:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1234:            &s_objet_argument) == d_erreur)
                   1235:    {
                   1236:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1237:        return;
                   1238:    }
                   1239: 
                   1240:    if ((*s_objet_argument).type == INT)
                   1241:    {
                   1242:        if (((*((integer8 *) (*s_objet_argument).objet)) < 1) ||
                   1243:                ((*((integer8 *) (*s_objet_argument).objet)) > 64))
                   1244:        {
                   1245:            liberation(s_etat_processus, s_objet_argument);
                   1246: 
                   1247:            (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
                   1248:            return;
                   1249:        }
                   1250: 
                   1251:        if ((s_objet_resultat = allocation(s_etat_processus, INT))
                   1252:                == NULL)
                   1253:        {
                   1254:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1255:            return;
                   1256:        }
                   1257: 
                   1258:        if (test_cfsf(s_etat_processus, (unsigned char) (*((integer8 *)
                   1259:                (*s_objet_argument).objet))) == d_vrai)
                   1260:        {
                   1261:            (*((integer8 *) (*s_objet_resultat).objet)) = 0;
                   1262:        }
                   1263:        else
                   1264:        {
                   1265:            (*((integer8 *) (*s_objet_resultat).objet)) = -1;
                   1266:        }
                   1267:    }
                   1268:    else
                   1269:    {
                   1270:        liberation(s_etat_processus, s_objet_argument);
                   1271: 
                   1272:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1273:        return;
                   1274:    }
                   1275: 
                   1276:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1277:            s_objet_resultat) == d_erreur)
                   1278:    {
                   1279:        return;
                   1280:    }
                   1281: 
                   1282:    liberation(s_etat_processus, s_objet_argument);
                   1283: 
                   1284:    return;
                   1285: }
                   1286: 
                   1287: 
                   1288: /*
                   1289: ================================================================================
                   1290:   Fonction 'fs?'
                   1291: ================================================================================
                   1292:   Entrées : structure processus
                   1293: --------------------------------------------------------------------------------
                   1294:   Sorties :
                   1295: --------------------------------------------------------------------------------
                   1296:   Effets de bord : néant
                   1297: ================================================================================
                   1298: */
                   1299: 
                   1300: void
                   1301: instruction_fs_test(struct_processus *s_etat_processus)
                   1302: {
                   1303:    struct_objet                *s_objet_argument;
                   1304:    struct_objet                *s_objet_resultat;
                   1305: 
                   1306:     (*s_etat_processus).erreur_execution = d_ex;
                   1307: 
                   1308:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1309:    {
                   1310:        printf("\n  FS? ");
                   1311: 
                   1312:        if ((*s_etat_processus).langue == 'F')
                   1313:        {
                   1314:            printf("(teste si un drapeau est armé)\n\n");
                   1315:        }
                   1316:        else
                   1317:        {
                   1318:            printf("(test if flag is set)\n\n");
                   1319:        }
                   1320: 
                   1321:        printf("    1: %s\n", d_INT);
                   1322:        printf("->  1: %s\n", d_INT);
                   1323: 
                   1324:        return;
                   1325:    }
                   1326:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1327:    {
                   1328:        (*s_etat_processus).nombre_arguments = -1;
                   1329:        return;
                   1330:    }
                   1331:    
                   1332:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   1333:    {
                   1334:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   1335:        {
                   1336:            return;
                   1337:        }
                   1338:    }
                   1339: 
                   1340:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1341:            &s_objet_argument) == d_erreur)
                   1342:    {
                   1343:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1344:        return;
                   1345:    }
                   1346: 
                   1347:    if ((*s_objet_argument).type == INT)
                   1348:    {
                   1349:        if (((*((integer8 *) (*s_objet_argument).objet)) < 1) ||
                   1350:                ((*((integer8 *) (*s_objet_argument).objet)) > 64))
                   1351:        {
                   1352:            liberation(s_etat_processus, s_objet_argument);
                   1353: 
                   1354:            (*s_etat_processus).erreur_execution = d_ex_drapeau_inexistant;
                   1355:            return;
                   1356:        }
                   1357: 
                   1358:        if ((s_objet_resultat = allocation(s_etat_processus, INT))
                   1359:                == NULL)
                   1360:        {
                   1361:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1362:            return;
                   1363:        }
                   1364: 
                   1365:        if (test_cfsf(s_etat_processus, (unsigned char) (*((integer8 *)
                   1366:                (*s_objet_argument).objet))) == d_vrai)
                   1367:        {
                   1368:            (*((integer8 *) (*s_objet_resultat).objet)) = -1;
                   1369:        }
                   1370:        else
                   1371:        {
                   1372:            (*((integer8 *) (*s_objet_resultat).objet)) = 0;
                   1373:        }
                   1374:    }
                   1375:    else
                   1376:    {
                   1377:        liberation(s_etat_processus, s_objet_argument);
                   1378: 
                   1379:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1380:        return;
                   1381:    }
                   1382: 
                   1383:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1384:            s_objet_resultat) == d_erreur)
                   1385:    {
                   1386:        return;
                   1387:    }
                   1388: 
                   1389:    liberation(s_etat_processus, s_objet_argument);
                   1390: 
                   1391:    return;
                   1392: }
                   1393: 
                   1394: 
                   1395: /*
                   1396: ================================================================================
                   1397:   Fonction 'fs?s'
                   1398: ================================================================================
                   1399:   Entrées : structure processus
                   1400: --------------------------------------------------------------------------------
                   1401:   Sorties :
                   1402: --------------------------------------------------------------------------------
                   1403:   Effets de bord : néant
                   1404: ================================================================================
                   1405: */
                   1406: 
                   1407: void
                   1408: instruction_fs_test_s(struct_processus *s_etat_processus)
                   1409: {
                   1410:     (*s_etat_processus).erreur_execution = d_ex;
                   1411: 
                   1412:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1413:    {
                   1414:        printf("\n  FS?S ");
                   1415: 
                   1416:        if ((*s_etat_processus).langue == 'F')
                   1417:        {
                   1418:            printf("(teste si un drapeau est armé et arme le drapeau)\n\n");
                   1419:        }
                   1420:        else
                   1421:        {
                   1422:            printf("(test if flag is set and set flag)\n\n");
                   1423:        }
                   1424: 
                   1425:        printf("    1: %s\n", d_INT);
                   1426:        printf("->  1: %s\n", d_INT);
                   1427: 
                   1428:        return;
                   1429:    }
                   1430:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1431:    {
                   1432:        (*s_etat_processus).nombre_arguments = -1;
                   1433:        return;
                   1434:    }
                   1435:    
                   1436:    instruction_dup(s_etat_processus);
                   1437: 
                   1438:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1439:            ((*s_etat_processus).erreur_execution != d_ex))
                   1440:    {
                   1441:        return;
                   1442:    }
                   1443: 
                   1444:    instruction_fs_test(s_etat_processus);
                   1445: 
                   1446:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1447:            ((*s_etat_processus).erreur_execution != d_ex))
                   1448:    {
                   1449:        return;
                   1450:    }
                   1451: 
                   1452:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1453:            ((*s_etat_processus).erreur_execution != d_ex))
                   1454:    {
                   1455:        return;
                   1456:    }
                   1457: 
                   1458:    instruction_swap(s_etat_processus);
                   1459: 
                   1460:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1461:            ((*s_etat_processus).erreur_execution != d_ex))
                   1462:    {
                   1463:        return;
                   1464:    }
                   1465: 
                   1466:    instruction_sf(s_etat_processus);
                   1467: 
                   1468:    return;
                   1469: }
                   1470: 
                   1471: 
                   1472: /*
                   1473: ================================================================================
                   1474:   Fonction 'fs?c'
                   1475: ================================================================================
                   1476:   Entrées : structure processus
                   1477: --------------------------------------------------------------------------------
                   1478:   Sorties :
                   1479: --------------------------------------------------------------------------------
                   1480:   Effets de bord : néant
                   1481: ================================================================================
                   1482: */
                   1483: 
                   1484: void
                   1485: instruction_fs_test_c(struct_processus *s_etat_processus)
                   1486: {
                   1487:     (*s_etat_processus).erreur_execution = d_ex;
                   1488: 
                   1489:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1490:    {
                   1491:        printf("\n  FS?C ");
                   1492: 
                   1493:        if ((*s_etat_processus).langue == 'F')
                   1494:        {
                   1495:            printf("(teste si un drapeau est armé et désarme le drapeau)\n\n");
                   1496:        }
                   1497:        else
                   1498:        {
                   1499:            printf("(test if flag is set and clear flag)\n\n");
                   1500:        }
                   1501: 
                   1502:        printf("    1: %s\n", d_INT);
                   1503:        printf("->  1: %s\n", d_INT);
                   1504: 
                   1505:        return;
                   1506:    }
                   1507:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1508:    {
                   1509:        (*s_etat_processus).nombre_arguments = -1;
                   1510:        return;
                   1511:    }
                   1512:    
                   1513:    instruction_dup(s_etat_processus);
                   1514: 
                   1515:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1516:            ((*s_etat_processus).erreur_execution != d_ex))
                   1517:    {
                   1518:        return;
                   1519:    }
                   1520: 
                   1521:    instruction_fs_test(s_etat_processus);
                   1522: 
                   1523:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1524:            ((*s_etat_processus).erreur_execution != d_ex))
                   1525:    {
                   1526:        return;
                   1527:    }
                   1528: 
                   1529:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1530:            ((*s_etat_processus).erreur_execution != d_ex))
                   1531:    {
                   1532:        return;
                   1533:    }
                   1534: 
                   1535:    instruction_swap(s_etat_processus);
                   1536: 
                   1537:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1538:            ((*s_etat_processus).erreur_execution != d_ex))
                   1539:    {
                   1540:        return;
                   1541:    }
                   1542: 
                   1543:    instruction_cf(s_etat_processus);
                   1544: 
                   1545:    return;
                   1546: }
                   1547: 
                   1548: 
                   1549: /*
                   1550: ================================================================================
                   1551:   Fonction 'fc?s'
                   1552: ================================================================================
                   1553:   Entrées : structure processus
                   1554: --------------------------------------------------------------------------------
                   1555:   Sorties :
                   1556: --------------------------------------------------------------------------------
                   1557:   Effets de bord : néant
                   1558: ================================================================================
                   1559: */
                   1560: 
                   1561: void
                   1562: instruction_fc_test_s(struct_processus *s_etat_processus)
                   1563: {
                   1564:     (*s_etat_processus).erreur_execution = d_ex;
                   1565: 
                   1566:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1567:    {
                   1568:        printf("\n  FC?S ");
                   1569: 
                   1570:        if ((*s_etat_processus).langue == 'F')
                   1571:        {
                   1572:            printf("(teste si un drapeau est désarmé et arme le drapeau)\n\n");
                   1573:        }
                   1574:        else
                   1575:        {
                   1576:            printf("(test if flag is clear and set flag)\n\n");
                   1577:        }
                   1578: 
                   1579:        printf("    1: %s\n", d_INT);
                   1580:        printf("->  1: %s\n", d_INT);
                   1581: 
                   1582:        return;
                   1583:    }
                   1584:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1585:    {
                   1586:        (*s_etat_processus).nombre_arguments = -1;
                   1587:        return;
                   1588:    }
                   1589:    
                   1590:    instruction_dup(s_etat_processus);
                   1591: 
                   1592:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1593:            ((*s_etat_processus).erreur_execution != d_ex))
                   1594:    {
                   1595:        return;
                   1596:    }
                   1597: 
                   1598:    instruction_fc_test(s_etat_processus);
                   1599: 
                   1600:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1601:            ((*s_etat_processus).erreur_execution != d_ex))
                   1602:    {
                   1603:        return;
                   1604:    }
                   1605: 
                   1606:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1607:            ((*s_etat_processus).erreur_execution != d_ex))
                   1608:    {
                   1609:        return;
                   1610:    }
                   1611: 
                   1612:    instruction_swap(s_etat_processus);
                   1613: 
                   1614:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1615:            ((*s_etat_processus).erreur_execution != d_ex))
                   1616:    {
                   1617:        return;
                   1618:    }
                   1619: 
                   1620:    instruction_sf(s_etat_processus);
                   1621: 
                   1622:    return;
                   1623: }
                   1624: 
                   1625: 
                   1626: /*
                   1627: ================================================================================
                   1628:   Fonction 'fc?c'
                   1629: ================================================================================
                   1630:   Entrées : structure processus
                   1631: --------------------------------------------------------------------------------
                   1632:   Sorties :
                   1633: --------------------------------------------------------------------------------
                   1634:   Effets de bord : néant
                   1635: ================================================================================
                   1636: */
                   1637: 
                   1638: void
                   1639: instruction_fc_test_c(struct_processus *s_etat_processus)
                   1640: {
                   1641:     (*s_etat_processus).erreur_execution = d_ex;
                   1642: 
                   1643:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1644:    {
                   1645:        printf("\n  FC?C ");
                   1646: 
                   1647:        if ((*s_etat_processus).langue == 'F')
                   1648:        {
                   1649:            printf("(teste si un drapeau est désarmé et désarme le drapeau)"
                   1650:                    "\n\n");
                   1651:        }
                   1652:        else
                   1653:        {
                   1654:            printf("(test if flag is clear and clear flag)\n\n");
                   1655:        }
                   1656: 
                   1657:        printf("    1: %s\n", d_INT);
                   1658:        printf("->  1: %s\n", d_INT);
                   1659: 
                   1660:        return;
                   1661:    }
                   1662:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1663:    {
                   1664:        (*s_etat_processus).nombre_arguments = -1;
                   1665:        return;
                   1666:    }
                   1667:    
                   1668:    instruction_dup(s_etat_processus);
                   1669: 
                   1670:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1671:            ((*s_etat_processus).erreur_execution != d_ex))
                   1672:    {
                   1673:        return;
                   1674:    }
                   1675: 
                   1676:    instruction_fc_test(s_etat_processus);
                   1677: 
                   1678:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1679:            ((*s_etat_processus).erreur_execution != d_ex))
                   1680:    {
                   1681:        return;
                   1682:    }
                   1683: 
                   1684:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1685:            ((*s_etat_processus).erreur_execution != d_ex))
                   1686:    {
                   1687:        return;
                   1688:    }
                   1689: 
                   1690:    instruction_swap(s_etat_processus);
                   1691: 
                   1692:    if (((*s_etat_processus).erreur_systeme != d_es) ||
                   1693:            ((*s_etat_processus).erreur_execution != d_ex))
                   1694:    {
                   1695:        return;
                   1696:    }
                   1697: 
                   1698:    instruction_cf(s_etat_processus);
                   1699: 
                   1700:    return;
                   1701: }
                   1702: 
                   1703: 
                   1704: /*
                   1705: ================================================================================
                   1706:   Fonction 'fact'
                   1707: ================================================================================
                   1708:   Entrées :
                   1709: --------------------------------------------------------------------------------
                   1710:   Sorties :
                   1711: --------------------------------------------------------------------------------
                   1712:   Effets de bord : néant
                   1713: ================================================================================
                   1714: */
                   1715: 
                   1716: void
                   1717: instruction_fact(struct_processus *s_etat_processus)
                   1718: {
                   1719:    logical1                            depassement;
                   1720: 
                   1721:    real8                               produit;
                   1722: 
                   1723:    integer8                            i;
                   1724:    integer8                            ifact;
                   1725:    integer8                            tampon;
                   1726: 
                   1727:    struct_liste_chainee                *l_element_courant;
                   1728:    struct_liste_chainee                *l_element_precedent;
                   1729: 
                   1730:    struct_objet                        *s_copie_argument;
                   1731:    struct_objet                        *s_objet_argument;
                   1732:    struct_objet                        *s_objet_resultat;
                   1733: 
                   1734:    (*s_etat_processus).erreur_execution = d_ex;
                   1735: 
                   1736:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1737:    {
                   1738:        printf("\n  FACT ");
                   1739: 
                   1740:        if ((*s_etat_processus).langue == 'F')
                   1741:        {
                   1742:            printf("(factorielle)\n\n");
                   1743:        }
                   1744:        else
                   1745:        {
                   1746:            printf("(factorial)\n\n");
                   1747:        }
                   1748: 
                   1749:        printf("    1: %s\n", d_INT);
                   1750:        printf("->  1: %s, %s\n\n", d_INT, d_REL);
                   1751: 
                   1752:        printf("    1: %s, %s\n", d_NOM, d_ALG);
                   1753:        printf("->  1: %s\n\n", d_ALG);
                   1754: 
                   1755:        printf("    1: %s\n", d_RPN);
                   1756:        printf("->  1: %s\n", d_RPN);
                   1757: 
                   1758:        return;
                   1759:    }
                   1760:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1761:    {
                   1762:        (*s_etat_processus).nombre_arguments = 1;
                   1763:        return;
                   1764:    }
                   1765:    
                   1766:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   1767:    {
                   1768:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   1769:        {
                   1770:            return;
                   1771:        }
                   1772:    }
                   1773: 
                   1774:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1775:            &s_objet_argument) == d_erreur)
                   1776:    {
                   1777:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1778:        return;
                   1779:    }
                   1780: 
                   1781: /*
                   1782: --------------------------------------------------------------------------------
                   1783:   Calcul de la factorielle d'un entier (résultat réel)
                   1784: --------------------------------------------------------------------------------
                   1785: */
                   1786: 
                   1787:    if ((*s_objet_argument).type == INT)
                   1788:    {
                   1789:        if ((*((integer8 *) (*s_objet_argument).objet)) < 0)
                   1790:        {
                   1791:            if (test_cfsf(s_etat_processus, 59) == d_vrai)
                   1792:            {
                   1793:                liberation(s_etat_processus, s_objet_argument);
                   1794: 
                   1795:                (*s_etat_processus).exception = d_ep_overflow;
                   1796:                return;
                   1797:            }
                   1798:            else
                   1799:            {
                   1800:                if ((s_objet_resultat = allocation(s_etat_processus, REL))
                   1801:                        == NULL)
                   1802:                {
                   1803:                    (*s_etat_processus).erreur_systeme =
                   1804:                            d_es_allocation_memoire;
                   1805:                    return;
                   1806:                }
                   1807: 
                   1808:                (*((real8 *) (*s_objet_resultat).objet)) =
                   1809:                        ((double) 1) / ((double) 0);
                   1810:            }
                   1811:        }
                   1812:        else
                   1813:        {
                   1814:            ifact = 1;
                   1815:            depassement = d_faux;
                   1816: 
                   1817:            for (i = 1; i <= (*((integer8 *) (*s_objet_argument).objet)); i++)
                   1818:            {
                   1819:                if (depassement_multiplication(&ifact, &i, &tampon) == d_erreur)
                   1820:                {
                   1821:                    depassement = d_vrai;
                   1822:                    break;
                   1823:                }
                   1824: 
                   1825:                ifact = tampon;
                   1826:            }
                   1827: 
                   1828:            if (depassement == d_faux)
                   1829:            {
                   1830:                if ((s_objet_resultat = allocation(s_etat_processus, INT))
                   1831:                        == NULL)
                   1832:                {
                   1833:                    (*s_etat_processus).erreur_systeme =
                   1834:                            d_es_allocation_memoire;
                   1835:                    return;
                   1836:                }
                   1837: 
                   1838:                (*((integer8 *) (*s_objet_resultat).objet)) = ifact;
                   1839:            }
                   1840:            else
                   1841:            {
                   1842:                produit = 1;
                   1843: 
                   1844:                for (i = 1; i <= (*((integer8 *) (*s_objet_argument).objet));
                   1845:                        i++)
                   1846:                {
                   1847:                    produit *= i;
                   1848:                }
                   1849: 
                   1850:                if ((s_objet_resultat = allocation(s_etat_processus, REL))
                   1851:                        == NULL)
                   1852:                {
                   1853:                    (*s_etat_processus).erreur_systeme =
                   1854:                            d_es_allocation_memoire;
                   1855:                    return;
                   1856:                }
                   1857: 
                   1858:                (*((real8 *) (*s_objet_resultat).objet)) = produit;
                   1859:            }
                   1860:        }
                   1861:    }
                   1862: 
                   1863: /*
                   1864: --------------------------------------------------------------------------------
                   1865:   Factorielle d'un nom
                   1866: --------------------------------------------------------------------------------
                   1867: */
                   1868: 
                   1869:    else if ((*s_objet_argument).type == NOM)
                   1870:    {
                   1871:        if ((s_objet_resultat = allocation(s_etat_processus, ALG))
                   1872:                == NULL)
                   1873:        {
                   1874:            (*s_etat_processus).erreur_systeme =
                   1875:                    d_es_allocation_memoire;
                   1876:            return;
                   1877:        }
                   1878: 
                   1879:        if (((*s_objet_resultat).objet =
                   1880:                allocation_maillon(s_etat_processus)) == NULL)
                   1881:        {
                   1882:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1883:            return;
                   1884:        }
                   1885: 
                   1886:        l_element_courant = (*s_objet_resultat).objet;
                   1887: 
                   1888:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   1889:                == NULL)
                   1890:        {
                   1891:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1892:            return;
                   1893:        }
                   1894: 
                   1895:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1896:                .nombre_arguments = 0;
                   1897:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1898:                .fonction = instruction_vers_niveau_superieur;
                   1899: 
                   1900:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1901:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   1902:        {
                   1903:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1904:            return;
                   1905:        }
                   1906: 
                   1907:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1908:                .nom_fonction, "<<");
                   1909: 
                   1910:        if (((*l_element_courant).suivant =
                   1911:                allocation_maillon(s_etat_processus)) == NULL)
                   1912:        {
                   1913:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1914:            return;
                   1915:        }
                   1916: 
                   1917:        l_element_courant = (*l_element_courant).suivant;
                   1918:        (*l_element_courant).donnee = s_objet_argument;
                   1919: 
                   1920:        if (((*l_element_courant).suivant =
                   1921:                allocation_maillon(s_etat_processus)) == NULL)
                   1922:        {
                   1923:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1924:            return;
                   1925:        }
                   1926: 
                   1927:        l_element_courant = (*l_element_courant).suivant;
                   1928: 
                   1929:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   1930:                == NULL)
                   1931:        {
                   1932:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1933:            return;
                   1934:        }
                   1935: 
                   1936:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1937:                .nombre_arguments = 1;
                   1938:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1939:                .fonction = instruction_fact;
                   1940: 
                   1941:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1942:                .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
                   1943:        {
                   1944:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1945:            return;
                   1946:        }
                   1947: 
                   1948:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1949:                .nom_fonction, "FACT");
                   1950: 
                   1951:        if (((*l_element_courant).suivant =
                   1952:                allocation_maillon(s_etat_processus)) == NULL)
                   1953:        {
                   1954:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1955:            return;
                   1956:        }
                   1957: 
                   1958:        l_element_courant = (*l_element_courant).suivant;
                   1959: 
                   1960:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   1961:                == NULL)
                   1962:        {
                   1963:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1964:            return;
                   1965:        }
                   1966: 
                   1967:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1968:                .nombre_arguments = 0;
                   1969:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1970:                .fonction = instruction_vers_niveau_inferieur;
                   1971: 
                   1972:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1973:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   1974:        {
                   1975:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1976:            return;
                   1977:        }
                   1978: 
                   1979:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1980:                .nom_fonction, ">>");
                   1981: 
                   1982:        (*l_element_courant).suivant = NULL;
                   1983:        s_objet_argument = NULL;
                   1984:    }
                   1985: 
                   1986: /*
                   1987: --------------------------------------------------------------------------------
                   1988:   Factorielle d'une expression
                   1989: --------------------------------------------------------------------------------
                   1990: */
                   1991: 
                   1992:    else if (((*s_objet_argument).type == ALG) ||
                   1993:            ((*s_objet_argument).type == RPN))
                   1994:    {
                   1995:        if ((s_copie_argument = copie_objet(s_etat_processus,
                   1996:                s_objet_argument, 'N')) == NULL)
                   1997:        {
                   1998:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1999:            return;
                   2000:        }
                   2001: 
                   2002:        l_element_courant = (struct_liste_chainee *)
                   2003:                (*s_copie_argument).objet;
                   2004:        l_element_precedent = l_element_courant;
                   2005: 
                   2006:        while((*l_element_courant).suivant != NULL)
                   2007:        {
                   2008:            l_element_precedent = l_element_courant;
                   2009:            l_element_courant = (*l_element_courant).suivant;
                   2010:        }
                   2011: 
                   2012:        if (((*l_element_precedent).suivant =
                   2013:                allocation_maillon(s_etat_processus)) == NULL)
                   2014:        {
                   2015:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2016:            return;
                   2017:        }
                   2018: 
                   2019:        if (((*(*l_element_precedent).suivant).donnee =
                   2020:                allocation(s_etat_processus, FCT)) == NULL)
                   2021:        {
                   2022:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2023:            return;
                   2024:        }
                   2025: 
                   2026:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   2027:                .donnee).objet)).nombre_arguments = 1;
                   2028:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   2029:                .donnee).objet)).fonction = instruction_fact;
                   2030: 
                   2031:        if (((*((struct_fonction *) (*(*(*l_element_precedent)
                   2032:                .suivant).donnee).objet)).nom_fonction =
                   2033:                malloc(5 * sizeof(unsigned char))) == NULL)
                   2034:        {
                   2035:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2036:            return;
                   2037:        }
                   2038: 
                   2039:        strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
                   2040:                .suivant).donnee).objet)).nom_fonction, "FACT");
                   2041: 
                   2042:        (*(*l_element_precedent).suivant).suivant = l_element_courant;
                   2043: 
                   2044:        s_objet_resultat = s_copie_argument;
                   2045:    }
                   2046: 
                   2047: /*
                   2048: --------------------------------------------------------------------------------
                   2049:   Factorielle impossible à réaliser
                   2050: --------------------------------------------------------------------------------
                   2051: */
                   2052: 
                   2053:    else
                   2054:    {
                   2055:        liberation(s_etat_processus, s_objet_argument);
                   2056: 
                   2057:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   2058:        return;
                   2059:    }
                   2060: 
                   2061:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   2062:            s_objet_resultat) == d_erreur)
                   2063:    {
                   2064:        return;
                   2065:    }
                   2066: 
                   2067:    liberation(s_etat_processus, s_objet_argument);
                   2068: 
                   2069:    return;
                   2070: }
                   2071: 
                   2072: 
                   2073: /*
                   2074: ================================================================================
                   2075:   Fonction 'floor'
                   2076: ================================================================================
                   2077:   Entrées :
                   2078: --------------------------------------------------------------------------------
                   2079:   Sorties :
                   2080: --------------------------------------------------------------------------------
                   2081:   Effets de bord : néant
                   2082: ================================================================================
                   2083: */
                   2084: 
                   2085: void
                   2086: instruction_floor(struct_processus *s_etat_processus)
                   2087: {
                   2088:    struct_liste_chainee                *l_element_courant;
                   2089:    struct_liste_chainee                *l_element_precedent;
                   2090: 
                   2091:    struct_objet                        *s_copie_argument;
                   2092:    struct_objet                        *s_objet_argument;
                   2093:    struct_objet                        *s_objet_resultat;
                   2094: 
                   2095:    (*s_etat_processus).erreur_execution = d_ex;
                   2096: 
                   2097:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   2098:    {
                   2099:        printf("\n  FLOOR ");
                   2100: 
                   2101:        if ((*s_etat_processus).langue == 'F')
                   2102:        {
                   2103:            printf("(valeur plancher)\n\n");
                   2104:        }
                   2105:        else
                   2106:        {
                   2107:            printf("(floor value)\n\n");
                   2108:        }
                   2109: 
                   2110:        printf("    1: %s\n", d_INT);
                   2111:        printf("->  1: %s\n\n", d_INT);
                   2112: 
                   2113:        printf("    1: %s\n", d_REL);
                   2114:        printf("->  1: %s, %s\n\n", d_INT, d_REL);
                   2115: 
                   2116:        printf("    1: %s, %s\n", d_NOM, d_ALG);
                   2117:        printf("->  1: %s\n\n", d_ALG);
                   2118: 
                   2119:        printf("    1: %s\n", d_RPN);
                   2120:        printf("->  1: %s\n", d_RPN);
                   2121: 
                   2122:        return;
                   2123:    }
                   2124:    else if ((*s_etat_processus).test_instruction == 'Y')
                   2125:    {
                   2126:        (*s_etat_processus).nombre_arguments = 1;
                   2127:        return;
                   2128:    }
                   2129:    
                   2130:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   2131:    {
                   2132:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   2133:        {
                   2134:            return;
                   2135:        }
                   2136:    }
                   2137: 
                   2138:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   2139:            &s_objet_argument) == d_erreur)
                   2140:    {
                   2141:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   2142:        return;
                   2143:    }
                   2144: 
                   2145: /*
                   2146: --------------------------------------------------------------------------------
                   2147:   Plancher d'un entier
                   2148: --------------------------------------------------------------------------------
                   2149: */
                   2150: 
                   2151:    if ((*s_objet_argument).type == INT)
                   2152:    {
                   2153:        s_objet_resultat = s_objet_argument;
                   2154:        s_objet_argument = NULL;
                   2155:    }
                   2156: 
                   2157: /*
                   2158: --------------------------------------------------------------------------------
                   2159:   Plancher d'un réel
                   2160: --------------------------------------------------------------------------------
                   2161: */
                   2162: 
                   2163:    else if ((*s_objet_argument).type == REL)
                   2164:    {
                   2165:        if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
                   2166:        {
                   2167:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2168:            return;
                   2169:        }
                   2170: 
                   2171:        (*((integer8 *) (*s_objet_resultat).objet)) =
                   2172:                floor((*((real8 *) (*s_objet_argument).objet)));
                   2173: 
                   2174:        if (!((((*((integer8 *) (*s_objet_resultat).objet)) <
                   2175:                (*((real8 *) (*s_objet_argument).objet))) && (((*((integer8 *)
                   2176:                (*s_objet_resultat).objet)) + 1) > (*((real8 *)
                   2177:                (*s_objet_argument).objet))))))
                   2178:        {
                   2179:            free((*s_objet_resultat).objet);
                   2180: 
                   2181:            if (((*s_objet_resultat).objet = malloc(sizeof(real8))) == NULL)
                   2182:            {
                   2183:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2184:                return;
                   2185:            }
                   2186: 
                   2187:            (*s_objet_resultat).type = REL;
                   2188:            (*((real8 *) (*s_objet_resultat).objet)) =
                   2189:                    ceil((*((real8 *) (*s_objet_argument).objet)));
                   2190:        }
                   2191:    }
                   2192: 
                   2193: /*
                   2194: --------------------------------------------------------------------------------
                   2195:   Plancher d'un nom
                   2196: --------------------------------------------------------------------------------
                   2197: */
                   2198: 
                   2199:    else if ((*s_objet_argument).type == NOM)
                   2200:    {
                   2201:        if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
                   2202:        {
                   2203:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2204:            return;
                   2205:        }
                   2206: 
                   2207:        if (((*s_objet_resultat).objet =
                   2208:                allocation_maillon(s_etat_processus)) == NULL)
                   2209:        {
                   2210:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2211:            return;
                   2212:        }
                   2213: 
                   2214:        l_element_courant = (*s_objet_resultat).objet;
                   2215: 
                   2216:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   2217:                == NULL)
                   2218:        {
                   2219:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2220:            return;
                   2221:        }
                   2222: 
                   2223:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2224:                .nombre_arguments = 0;
                   2225:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2226:                .fonction = instruction_vers_niveau_superieur;
                   2227: 
                   2228:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2229:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   2230:        {
                   2231:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2232:            return;
                   2233:        }
                   2234: 
                   2235:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2236:                .nom_fonction, "<<");
                   2237: 
                   2238:        if (((*l_element_courant).suivant =
                   2239:                allocation_maillon(s_etat_processus)) == NULL)
                   2240:        {
                   2241:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2242:            return;
                   2243:        }
                   2244: 
                   2245:        l_element_courant = (*l_element_courant).suivant;
                   2246:        (*l_element_courant).donnee = s_objet_argument;
                   2247: 
                   2248:        if (((*l_element_courant).suivant =
                   2249:                allocation_maillon(s_etat_processus)) == NULL)
                   2250:        {
                   2251:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2252:            return;
                   2253:        }
                   2254: 
                   2255:        l_element_courant = (*l_element_courant).suivant;
                   2256: 
                   2257:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   2258:                == NULL)
                   2259:        {
                   2260:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2261:            return;
                   2262:        }
                   2263: 
                   2264:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2265:                .nombre_arguments = 1;
                   2266:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2267:                .fonction = instruction_floor;
                   2268: 
                   2269:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2270:                .nom_fonction = malloc(6 * sizeof(unsigned char))) == NULL)
                   2271:        {
                   2272:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2273:            return;
                   2274:        }
                   2275: 
                   2276:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2277:                .nom_fonction, "FLOOR");
                   2278: 
                   2279:        if (((*l_element_courant).suivant =
                   2280:                allocation_maillon(s_etat_processus)) == NULL)
                   2281:        {
                   2282:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2283:            return;
                   2284:        }
                   2285: 
                   2286:        l_element_courant = (*l_element_courant).suivant;
                   2287: 
                   2288:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   2289:                == NULL)
                   2290:        {
                   2291:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2292:            return;
                   2293:        }
                   2294: 
                   2295:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2296:                .nombre_arguments = 0;
                   2297:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2298:                .fonction = instruction_vers_niveau_inferieur;
                   2299: 
                   2300:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2301:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   2302:        {
                   2303:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2304:            return;
                   2305:        }
                   2306: 
                   2307:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2308:                .nom_fonction, ">>");
                   2309: 
                   2310:        (*l_element_courant).suivant = NULL;
                   2311:        s_objet_argument = NULL;
                   2312:    }
                   2313: 
                   2314: /*
                   2315: --------------------------------------------------------------------------------
                   2316:   Plancher d'une expression
                   2317: --------------------------------------------------------------------------------
                   2318: */
                   2319: 
                   2320:    else if (((*s_objet_argument).type == ALG) ||
                   2321:            ((*s_objet_argument).type == RPN))
                   2322:    {
                   2323:        if ((s_copie_argument = copie_objet(s_etat_processus,
                   2324:                s_objet_argument, 'N')) == NULL)
                   2325:        {
                   2326:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2327:            return;
                   2328:        }
                   2329: 
                   2330:        l_element_courant = (struct_liste_chainee *)
                   2331:                (*s_copie_argument).objet;
                   2332:        l_element_precedent = l_element_courant;
                   2333: 
                   2334:        while((*l_element_courant).suivant != NULL)
                   2335:        {
                   2336:            l_element_precedent = l_element_courant;
                   2337:            l_element_courant = (*l_element_courant).suivant;
                   2338:        }
                   2339: 
                   2340:        if (((*l_element_precedent).suivant =
                   2341:                allocation_maillon(s_etat_processus)) == NULL)
                   2342:        {
                   2343:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2344:            return;
                   2345:        }
                   2346: 
                   2347:        if (((*(*l_element_precedent).suivant).donnee =
                   2348:                allocation(s_etat_processus, FCT)) == NULL)
                   2349:        {
                   2350:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2351:            return;
                   2352:        }
                   2353: 
                   2354:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   2355:                .donnee).objet)).nombre_arguments = 1;
                   2356:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   2357:                .donnee).objet)).fonction = instruction_floor;
                   2358: 
                   2359:        if (((*((struct_fonction *) (*(*(*l_element_precedent)
                   2360:                .suivant).donnee).objet)).nom_fonction =
                   2361:                malloc(6 * sizeof(unsigned char))) == NULL)
                   2362:        {
                   2363:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2364:            return;
                   2365:        }
                   2366: 
                   2367:        strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
                   2368:                .suivant).donnee).objet)).nom_fonction, "FLOOR");
                   2369: 
                   2370:        (*(*l_element_precedent).suivant).suivant = l_element_courant;
                   2371: 
                   2372:        s_objet_resultat = s_copie_argument;
                   2373:    }
                   2374: 
                   2375: /*
                   2376: --------------------------------------------------------------------------------
                   2377:   Fonction floor impossible à réaliser
                   2378: --------------------------------------------------------------------------------
                   2379: */
                   2380: 
                   2381:    else
                   2382:    {
                   2383:        liberation(s_etat_processus, s_objet_argument);
                   2384: 
                   2385:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   2386:        return;
                   2387:    }
                   2388: 
                   2389:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   2390:            s_objet_resultat) == d_erreur)
                   2391:    {
                   2392:        return;
                   2393:    }
                   2394: 
                   2395:    liberation(s_etat_processus, s_objet_argument);
                   2396: 
                   2397:    return;
                   2398: }
                   2399: 
                   2400: 
                   2401: /*
                   2402: ================================================================================
                   2403:   Fonction 'fp'
                   2404: ================================================================================
                   2405:   Entrées :
                   2406: --------------------------------------------------------------------------------
                   2407:   Sorties :
                   2408: --------------------------------------------------------------------------------
                   2409:   Effets de bord : néant
                   2410: ================================================================================
                   2411: */
                   2412: 
                   2413: void
                   2414: instruction_fp(struct_processus *s_etat_processus)
                   2415: {
                   2416:    struct_liste_chainee                *l_element_courant;
                   2417:    struct_liste_chainee                *l_element_precedent;
                   2418: 
                   2419:    struct_objet                        *s_copie_argument;
                   2420:    struct_objet                        *s_objet_argument;
                   2421:    struct_objet                        *s_objet_resultat;
                   2422: 
                   2423:    (*s_etat_processus).erreur_execution = d_ex;
                   2424: 
                   2425:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   2426:    {
                   2427:        printf("\n  FP ");
                   2428: 
                   2429:        if ((*s_etat_processus).langue == 'F')
                   2430:        {
                   2431:            printf("(part fractionnaire)\n\n");
                   2432:        }
                   2433:        else
                   2434:        {
                   2435:            printf("(fractional part)\n\n");
                   2436:        }
                   2437: 
                   2438:        printf("    1: %s, %s\n", d_INT, d_REL);
                   2439:        printf("->  1: %s\n\n", d_REL);
                   2440: 
                   2441:        printf("    1: %s, %s\n", d_NOM, d_ALG);
                   2442:        printf("->  1: %s\n\n", d_ALG);
                   2443: 
                   2444:        printf("    1: %s\n", d_RPN);
                   2445:        printf("->  1: %s\n", d_RPN);
                   2446: 
                   2447:        return;
                   2448:    }
                   2449:    else if ((*s_etat_processus).test_instruction == 'Y')
                   2450:    {
                   2451:        (*s_etat_processus).nombre_arguments = 1;
                   2452:        return;
                   2453:    }
                   2454:    
                   2455:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   2456:    {
                   2457:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   2458:        {
                   2459:            return;
                   2460:        }
                   2461:    }
                   2462: 
                   2463:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   2464:            &s_objet_argument) == d_erreur)
                   2465:    {
                   2466:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   2467:        return;
                   2468:    }
                   2469: 
                   2470: /*
                   2471: --------------------------------------------------------------------------------
                   2472:   fp d'un entier
                   2473: --------------------------------------------------------------------------------
                   2474: */
                   2475: 
                   2476:    if ((*s_objet_argument).type == INT)
                   2477:    {
                   2478:        if ((s_objet_resultat = allocation(s_etat_processus, REL))
                   2479:                == NULL)
                   2480:        {
                   2481:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2482:            return;
                   2483:        }
                   2484: 
                   2485:        (*((real8 *) (*s_objet_resultat).objet)) = 0;
                   2486:    }
                   2487: 
                   2488: /*
                   2489: --------------------------------------------------------------------------------
                   2490:   fp d'un réel
                   2491: --------------------------------------------------------------------------------
                   2492: */
                   2493: 
                   2494:    else if ((*s_objet_argument).type == REL)
                   2495:    {
                   2496:        if ((s_objet_resultat = allocation(s_etat_processus, REL))
                   2497:                == NULL)
                   2498:        {
                   2499:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2500:            return;
                   2501:        }
                   2502: 
                   2503:        if ((*((real8 *) (*s_objet_argument).objet)) > 0)
                   2504:        {
                   2505:            (*((real8 *) (*s_objet_resultat).objet)) =
                   2506:                    (*((real8 *) (*s_objet_argument).objet)) -
                   2507:                    floor((*((real8 *) (*s_objet_argument).objet)));
                   2508:        }
                   2509:        else
                   2510:        {
                   2511:            (*((real8 *) (*s_objet_resultat).objet)) =
                   2512:                    (*((real8 *) (*s_objet_argument).objet)) -
                   2513:                    ceil((*((real8 *) (*s_objet_argument).objet)));
                   2514:        }
                   2515:    }
                   2516: 
                   2517: /*
                   2518: --------------------------------------------------------------------------------
                   2519:   fp d'un nom
                   2520: --------------------------------------------------------------------------------
                   2521: */
                   2522: 
                   2523:    else if ((*s_objet_argument).type == NOM)
                   2524:    {
                   2525:        if ((s_objet_resultat = allocation(s_etat_processus, ALG))
                   2526:                == NULL)
                   2527:        {
                   2528:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2529:            return;
                   2530:        }
                   2531: 
                   2532:        if (((*s_objet_resultat).objet =
                   2533:                allocation_maillon(s_etat_processus)) == NULL)
                   2534:        {
                   2535:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2536:            return;
                   2537:        }
                   2538: 
                   2539:        l_element_courant = (*s_objet_resultat).objet;
                   2540: 
                   2541:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   2542:                == NULL)
                   2543:        {
                   2544:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2545:            return;
                   2546:        }
                   2547: 
                   2548:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2549:                .nombre_arguments = 0;
                   2550:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2551:                .fonction = instruction_vers_niveau_superieur;
                   2552: 
                   2553:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2554:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   2555:        {
                   2556:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2557:            return;
                   2558:        }
                   2559: 
                   2560:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2561:                .nom_fonction, "<<");
                   2562: 
                   2563:        if (((*l_element_courant).suivant =
                   2564:                allocation_maillon(s_etat_processus)) == NULL)
                   2565:        {
                   2566:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2567:            return;
                   2568:        }
                   2569: 
                   2570:        l_element_courant = (*l_element_courant).suivant;
                   2571:        (*l_element_courant).donnee = s_objet_argument;
                   2572: 
                   2573:        if (((*l_element_courant).suivant =
                   2574:                allocation_maillon(s_etat_processus)) == NULL)
                   2575:        {
                   2576:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2577:            return;
                   2578:        }
                   2579: 
                   2580:        l_element_courant = (*l_element_courant).suivant;
                   2581: 
                   2582:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   2583:                == NULL)
                   2584:        {
                   2585:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2586:            return;
                   2587:        }
                   2588: 
                   2589:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2590:                .nombre_arguments = 1;
                   2591:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2592:                .fonction = instruction_fp;
                   2593: 
                   2594:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2595:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   2596:        {
                   2597:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2598:            return;
                   2599:        }
                   2600: 
                   2601:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2602:                .nom_fonction, "FP");
                   2603: 
                   2604:        if (((*l_element_courant).suivant =
                   2605:                allocation_maillon(s_etat_processus)) == NULL)
                   2606:        {
                   2607:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2608:            return;
                   2609:        }
                   2610: 
                   2611:        l_element_courant = (*l_element_courant).suivant;
                   2612: 
                   2613:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   2614:                == NULL)
                   2615:        {
                   2616:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2617:            return;
                   2618:        }
                   2619: 
                   2620:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2621:                .nombre_arguments = 0;
                   2622:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2623:                .fonction = instruction_vers_niveau_inferieur;
                   2624: 
                   2625:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2626:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   2627:        {
                   2628:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2629:            return;
                   2630:        }
                   2631: 
                   2632:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   2633:                .nom_fonction, ">>");
                   2634: 
                   2635:        (*l_element_courant).suivant = NULL;
                   2636:        s_objet_argument = NULL;
                   2637:    }
                   2638: 
                   2639: /*
                   2640: --------------------------------------------------------------------------------
                   2641:   fp d'une expression
                   2642: --------------------------------------------------------------------------------
                   2643: */
                   2644: 
                   2645:    else if (((*s_objet_argument).type == ALG) ||
                   2646:            ((*s_objet_argument).type == RPN))
                   2647:    {
                   2648:        if ((s_copie_argument = copie_objet(s_etat_processus,
                   2649:                s_objet_argument, 'N')) == NULL)
                   2650:        {
                   2651:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2652:            return;
                   2653:        }
                   2654: 
                   2655:        l_element_courant = (struct_liste_chainee *)
                   2656:                (*s_copie_argument).objet;
                   2657:        l_element_precedent = l_element_courant;
                   2658: 
                   2659:        while((*l_element_courant).suivant != NULL)
                   2660:        {
                   2661:            l_element_precedent = l_element_courant;
                   2662:            l_element_courant = (*l_element_courant).suivant;
                   2663:        }
                   2664: 
                   2665:        if (((*l_element_precedent).suivant =
                   2666:                allocation_maillon(s_etat_processus)) == NULL)
                   2667:        {
                   2668:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2669:            return;
                   2670:        }
                   2671: 
                   2672:        if (((*(*l_element_precedent).suivant).donnee =
                   2673:                allocation(s_etat_processus, FCT)) == NULL)
                   2674:        {
                   2675:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2676:            return;
                   2677:        }
                   2678: 
                   2679:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   2680:                .donnee).objet)).nombre_arguments = 1;
                   2681:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   2682:                .donnee).objet)).fonction = instruction_fp;
                   2683: 
                   2684:        if (((*((struct_fonction *) (*(*(*l_element_precedent)
                   2685:                .suivant).donnee).objet)).nom_fonction =
                   2686:                malloc(3 * sizeof(unsigned char))) == NULL)
                   2687:        {
                   2688:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2689:            return;
                   2690:        }
                   2691: 
                   2692:        strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
                   2693:                .suivant).donnee).objet)).nom_fonction, "FP");
                   2694: 
                   2695:        (*(*l_element_precedent).suivant).suivant = l_element_courant;
                   2696: 
                   2697:        s_objet_resultat = s_copie_argument;
                   2698:    }
                   2699: 
                   2700: /*
                   2701: --------------------------------------------------------------------------------
                   2702:   Fonction fp impossible à réaliser
                   2703: --------------------------------------------------------------------------------
                   2704: */
                   2705: 
                   2706:    else
                   2707:    {
                   2708:        liberation(s_etat_processus, s_objet_argument);
                   2709: 
                   2710:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   2711:        return;
                   2712:    }
                   2713: 
                   2714:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   2715:            s_objet_resultat) == d_erreur)
                   2716:    {
                   2717:        return;
                   2718:    }
                   2719: 
                   2720:    liberation(s_etat_processus, s_objet_argument);
                   2721: 
                   2722:    return;
                   2723: }
                   2724: 
                   2725: 
                   2726: /*
                   2727: ================================================================================
                   2728:   Fonction 'fix'
                   2729: ================================================================================
                   2730:   Entrées : pointeur sur une struct_processus
                   2731: --------------------------------------------------------------------------------
                   2732:   Sorties :
                   2733: --------------------------------------------------------------------------------
                   2734:   Effets de bord : néant
                   2735: ================================================================================
                   2736: */
                   2737: 
                   2738: void
                   2739: instruction_fix(struct_processus *s_etat_processus)
                   2740: {
                   2741:    struct_objet                        *s_objet_argument;
                   2742:    struct_objet                        *s_objet;
                   2743: 
                   2744:    logical1                            i43;
                   2745:    logical1                            i44;
                   2746: 
                   2747:    unsigned char                       *valeur_binaire;
                   2748: 
                   2749:    unsigned long                       i;
                   2750:    unsigned long                       j;
                   2751: 
                   2752:    (*s_etat_processus).erreur_execution = d_ex;
                   2753: 
                   2754:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   2755:    {
                   2756:        printf("\n  FIX ");
                   2757: 
                   2758:        if ((*s_etat_processus).langue == 'F')
                   2759:        {
                   2760:            printf("(format virgule fixe)\n\n");
                   2761:        }
                   2762:        else
                   2763:        {
                   2764:            printf("(fixed point format)\n\n");
                   2765:        }
                   2766: 
                   2767:        printf("    1: %s\n", d_INT);
                   2768: 
                   2769:        return;
                   2770:    }
                   2771:    else if ((*s_etat_processus).test_instruction == 'Y')
                   2772:    {
                   2773:        (*s_etat_processus).nombre_arguments = -1;
                   2774:        return;
                   2775:    }
                   2776: 
                   2777:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   2778:    {
                   2779:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   2780:        {
                   2781:            return;
                   2782:        }
                   2783:    }
                   2784: 
                   2785:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   2786:            &s_objet_argument) == d_erreur)
                   2787:    {
                   2788:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   2789:        return;
                   2790:    }
                   2791: 
                   2792:    if ((*s_objet_argument).type == INT)
                   2793:    {
                   2794:        if (((*((integer8 *) (*s_objet_argument).objet)) >= 0) &&
                   2795:                ((*((integer8 *) (*s_objet_argument).objet)) <= 15))
                   2796:        {
                   2797:            if ((s_objet = allocation(s_etat_processus, BIN)) == NULL)
                   2798:            {
                   2799:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2800:                return;
                   2801:            }
                   2802: 
                   2803:            (*((logical8 *) (*s_objet).objet)) =
                   2804:                    (*((integer8 *) (*s_objet_argument).objet));
                   2805: 
                   2806:            i43 = test_cfsf(s_etat_processus, 43);
                   2807:            i44 = test_cfsf(s_etat_processus, 44);
                   2808: 
                   2809:            sf(s_etat_processus, 44);
                   2810:            cf(s_etat_processus, 43);
                   2811: 
                   2812:            if ((valeur_binaire = formateur(s_etat_processus, 0, s_objet))
                   2813:                    == NULL)
                   2814:            {
                   2815:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   2816:                return;
                   2817:            }
                   2818: 
                   2819:            if (i43 == d_vrai)
                   2820:            {
                   2821:                sf(s_etat_processus, 43);
                   2822:            }
                   2823:            else
                   2824:            {
                   2825:                cf(s_etat_processus, 43);
                   2826:            }
                   2827: 
                   2828:            if (i44 == d_vrai)
                   2829:            {
                   2830:                sf(s_etat_processus, 44);
                   2831:            }
                   2832:            else
                   2833:            {
                   2834:                cf(s_etat_processus, 44);
                   2835:            }
                   2836: 
                   2837:            for(j = 53, i = strlen(valeur_binaire) - 2; i >= 2; i--)
                   2838:            {
                   2839:                if (valeur_binaire[i] == '0')
                   2840:                {
                   2841:                    cf(s_etat_processus, j++);
                   2842:                }
                   2843:                else
                   2844:                {
                   2845:                    sf(s_etat_processus, j++);
                   2846:                }
                   2847:            }
                   2848: 
                   2849:            for(; j <= 56; cf(s_etat_processus, j++));
                   2850: 
                   2851:            sf(s_etat_processus, 49);
                   2852:            cf(s_etat_processus, 50);
                   2853: 
                   2854:            free(valeur_binaire);
                   2855:            liberation(s_etat_processus, s_objet);
                   2856:        }
                   2857:        else
                   2858:        {
                   2859:            liberation(s_etat_processus, s_objet_argument);
                   2860: 
                   2861:            (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                   2862:            return;
                   2863:        }
                   2864:    }
                   2865:    else
                   2866:    {
                   2867:        liberation(s_etat_processus, s_objet_argument);
                   2868: 
                   2869:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   2870:        return;
                   2871:    }
                   2872: 
                   2873:    liberation(s_etat_processus, s_objet_argument);
                   2874: 
                   2875:    return;
                   2876: }
                   2877: 
                   2878: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>