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

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

CVSweb interface <joel.bertrand@systella.fr>