Annotation of rpl/src/interface_cas.cpp, revision 1.55

1.1       bertrand    1: /*
                      2: ================================================================================
1.55    ! bertrand    3:   RPL/2 (R) version 4.1.28
1.52      bertrand    4:   Copyright (C) 1989-2017 Dr. BERTRAND Joël
1.1       bertrand    5: 
                      6:   This file is part of RPL/2.
                      7: 
                      8:   RPL/2 is free software; you can redistribute it and/or modify it
                      9:   under the terms of the CeCILL V2 License as published by the french
                     10:   CEA, CNRS and INRIA.
                     11:  
                     12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
                     13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
                     14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
                     15:   for more details.
                     16:  
                     17:   You should have received a copy of the CeCILL License
                     18:   along with RPL/2. If not, write to info@cecill.info.
                     19: ================================================================================
                     20: */
                     21: 
1.43      bertrand   22: 
1.9       bertrand   23: #ifdef RPLCAS
1.17      bertrand   24: 
                     25: // Giac inclut <semaphore.h> et définit sem_t. Or l'émulation
                     26: // des IPCS POSIX requiert une redéfinition de sem_t.
                     27: 
                     28: #  ifdef IPCS_SYSV
                     29: //     NetBSD : _SEMAPHORE_H_
                     30: #      define _SEMAPHORE_H_
1.42      bertrand   31: //     Linux : _SEMAPHORE_H
                     32: #      define _SEMAPHORE_H
1.17      bertrand   33: #  endif
                     34: 
1.41      bertrand   35: #  pragma GCC diagnostic push
                     36: #  pragma GCC diagnostic ignored "-Wstrict-aliasing"
                     37: #  pragma GCC diagnostic ignored "-Wunused-parameter"
                     38: #  pragma GCC diagnostic ignored "-Wempty-body"
1.54      bertrand   39: #  pragma GCC diagnostic ignored "-Wunknown-pragmas"
1.9       bertrand   40: #  include "giac.h"
1.41      bertrand   41: #  pragma GCC diagnostic pop
1.2       bertrand   42: 
1.9       bertrand   43: #  undef PACKAGE
                     44: #  undef PACKAGE_NAME
                     45: #  undef PACKAGE_STRING
                     46: #  undef PACKAGE_TARNAME
                     47: #  undef PACKAGE_VERSION
                     48: #  undef VERSION
                     49: #endif
1.3       bertrand   50: 
1.1       bertrand   51: extern "C"
                     52: {
1.3       bertrand   53: #  define __RPLCAS
1.1       bertrand   54: #  include "rpl-conv.h"
                     55: }
                     56: 
                     57: #include <iostream>
                     58: 
                     59: using namespace std;
1.9       bertrand   60: 
                     61: #ifdef RPLCAS
                     62:    using namespace giac;
                     63: #endif
1.2       bertrand   64: 
1.14      bertrand   65: void
                     66: initialisation_contexte_cas(struct_processus *s_etat_processus)
                     67: {
                     68:    s_etat_processus->contexte_cas = NULL;
                     69:    return;
                     70: }
                     71: 
                     72: void
                     73: liberation_contexte_cas(struct_processus *s_etat_processus)
                     74: {
1.15      bertrand   75:    if (s_etat_processus->contexte_cas != NULL)
                     76:    {
1.16      bertrand   77: #      ifdef RPLCAS
1.15      bertrand   78:        delete reinterpret_cast<giac::context *>(
                     79:                s_etat_processus->contexte_cas);
1.16      bertrand   80: #      endif
1.15      bertrand   81:        s_etat_processus->contexte_cas = NULL;
                     82:    }
1.14      bertrand   83: 
                     84:    return;
                     85: }
1.1       bertrand   86: 
1.19      bertrand   87: #ifdef RPLCAS
1.4       bertrand   88: static unsigned char *
                     89: conversion_rpl_vers_cas(struct_processus *s_etat_processus,
                     90:        struct_objet **s_objet)
                     91: {
1.12      bertrand   92:    logical1                drapeau;
                     93: 
1.4       bertrand   94:    struct_liste_chainee    *l_element_courant;
                     95: 
                     96:    struct_objet            *s_objet_temporaire;
                     97: 
                     98:    t_8_bits                registre[8];
                     99: 
                    100:    unsigned char           *resultat;
1.12      bertrand  101:    unsigned char           *index;
1.4       bertrand  102: 
                    103:    for(int i = 0; i < 8; i++)
                    104:    {
                    105:        registre[i] = s_etat_processus->drapeaux_etat[i];
                    106:    }
                    107: 
1.12      bertrand  108:    sf(s_etat_processus, 35);
1.4       bertrand  109:    cf(s_etat_processus, 48);
                    110:    cf(s_etat_processus, 49);
                    111:    cf(s_etat_processus, 50);
                    112:    cf(s_etat_processus, 53);
                    113:    cf(s_etat_processus, 54);
                    114:    cf(s_etat_processus, 55);
                    115:    cf(s_etat_processus, 56);
                    116: 
                    117:    // GIAC considère que les fonctions sont écrites en minuscules. Le RPL/2
                    118:    // part de l'hypothèse inverse. Il faut donc convertir en minuscules tous
                    119:    // les noms de fonction. Les fonctions ne peuvent apparaître que dans le
                    120:    // cas d'un objet de type ALG.
                    121: 
1.12      bertrand  122:    if ((*s_objet)->type == NOM)
                    123:    {
                    124:        if (strcmp((const char *) reinterpret_cast<unsigned char *>(
                    125:                reinterpret_cast<struct_nom *>((*s_objet)->objet)->nom),
                    126:                "infinity") == 0)
                    127:        {
                    128:            if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
                    129:            {
                    130:                return(NULL);
                    131:            }
                    132: 
                    133:            liberation(s_etat_processus, *s_objet);
                    134: 
                    135:            if (depilement(s_etat_processus, &(s_etat_processus
                    136:                    ->l_base_pile), s_objet) == d_erreur)
                    137:            {
                    138:                return(NULL);
                    139:            }
                    140:        }
                    141:    }
                    142:    else if ((*s_objet)->type == ALG)
1.4       bertrand  143:    {
1.12      bertrand  144:        if ((s_objet_temporaire = copie_objet(s_etat_processus,
                    145:                (*s_objet), 'O')) == NULL)
                    146:        {
                    147:            s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    148:            return(NULL);
                    149:        }
                    150: 
                    151:        liberation(s_etat_processus, (*s_objet));
                    152:        (*s_objet) = s_objet_temporaire;
                    153: 
                    154:        // Si l'expression contient la fonction infinity, on commence par
                    155:        // forcer une évaluation numérique.
                    156: 
                    157:        l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                    158:                (*s_objet)->objet);
                    159:        drapeau = d_faux;
                    160: 
                    161:        while(l_element_courant != NULL)
                    162:        {
                    163:            if (l_element_courant->donnee->type == NOM)
                    164:            {
                    165:                if (strcmp((const char *) reinterpret_cast<unsigned char *>(
                    166:                        reinterpret_cast<struct_nom *>(
                    167:                        l_element_courant->donnee->objet)->nom),
                    168:                        "infinity") == 0)
                    169:                {
                    170:                    drapeau = d_vrai;
                    171:                    break;
                    172:                }
                    173:            }
                    174: 
                    175:            l_element_courant = l_element_courant->suivant;
                    176:        }
                    177: 
                    178:        if (drapeau == d_vrai)
1.4       bertrand  179:        {
1.12      bertrand  180:            if (evaluation(s_etat_processus, *s_objet, 'N') == d_erreur)
1.4       bertrand  181:            {
                    182:                return(NULL);
                    183:            }
                    184: 
1.12      bertrand  185:            liberation(s_etat_processus, *s_objet);
                    186: 
                    187:            if (depilement(s_etat_processus, &(s_etat_processus
                    188:                    ->l_base_pile), s_objet) == d_erreur)
                    189:            {
                    190:                return(NULL);
                    191:            }
1.4       bertrand  192:        }
1.12      bertrand  193:    }
                    194: 
                    195:    if ((*s_objet)->type == ALG)
                    196:    {
1.4       bertrand  197: 
                    198:        l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                    199:                (*s_objet)->objet);
                    200: 
                    201:        while(l_element_courant != NULL)
                    202:        {
                    203:            if (l_element_courant->donnee->type == FCT)
                    204:            {
                    205:                unsigned char       *ptr;
                    206: 
1.6       bertrand  207:                ptr = reinterpret_cast<unsigned char *>(
                    208:                        reinterpret_cast<struct_fonction *>(
1.4       bertrand  209:                        l_element_courant->donnee->objet)->nom_fonction);
                    210: 
                    211:                while((*ptr) != d_code_fin_chaine)
                    212:                {
                    213:                    int c = (*ptr);
                    214: 
                    215:                    if (isalpha(c))
                    216:                    {
                    217:                        c = tolower(c);
                    218:                        (*ptr) = (unsigned char) c;
                    219:                    }
                    220: 
                    221:                    ptr++;
                    222:                }
                    223:            }
                    224: 
                    225:            l_element_courant = l_element_courant->suivant;
                    226:        }
                    227:    }
                    228: 
                    229:    resultat = formateur(s_etat_processus, 0, (*s_objet));
1.12      bertrand  230: 
                    231:    // Il faut remplacer les occurrences de 'relax' par '    +'.
                    232: 
                    233:    index = resultat;
                    234:    while((index = reinterpret_cast<unsigned char *>(
                    235:            strstr(reinterpret_cast<char *>(index),
                    236:            (const char *) "relax"))) != NULL)
                    237:    {
                    238:        strncpy(reinterpret_cast<char *>(index), "    +", 5);
                    239:    }
                    240: 
                    241:    // Si le résultat vaut infinity, on rajoute le signe +.
                    242: 
                    243:    if (strcmp(reinterpret_cast<char *>(resultat), "infinity") == 0)
                    244:    {
                    245:        if ((resultat = reinterpret_cast<unsigned char *>(
                    246:                realloc(resultat, (strlen(reinterpret_cast<char *>(
                    247:                resultat)) + 2) * sizeof(unsigned char)))) == NULL)
                    248:        {
                    249:            s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    250:            return(NULL);
                    251:        }
                    252: 
                    253:        strcpy(reinterpret_cast<char *>(resultat), "+infinity");
                    254:    }
                    255: 
                    256:    if (resultat[0] == '\'')
                    257:    {
                    258:        resultat[0] = ' ';
                    259:        resultat[strlen((const char *) resultat) - 1] = ' ';
                    260:    }
1.4       bertrand  261: 
                    262:    for(int i = 0; i < 8; i++)
                    263:    {
                    264:        s_etat_processus->drapeaux_etat[i] = registre[i];
                    265:    }
                    266: 
                    267:    return(resultat);
                    268: }
                    269: 
                    270: 
                    271: static void
                    272: conversion_cas_vers_rpl(struct_processus *s_etat_processus,
1.13      bertrand  273:        unsigned char *expression)
1.4       bertrand  274: {
1.13      bertrand  275:    logical1                    drapeau;
                    276: 
1.4       bertrand  277:    struct_liste_chainee        *l_element_courant;
                    278: 
1.13      bertrand  279:    struct_objet                *s_objet;
                    280: 
                    281:    unsigned char               *registre;
                    282: 
                    283:    registre = s_etat_processus->instruction_courante;
                    284:    s_etat_processus->instruction_courante = expression;
                    285:    recherche_type(s_etat_processus);
                    286:    s_etat_processus->instruction_courante = registre;
                    287: 
                    288:    if ((s_etat_processus->l_base_pile == NULL) ||
                    289:            (s_etat_processus->erreur_execution != d_ex) ||
                    290:            (s_etat_processus->erreur_systeme != d_es))
                    291:    {
                    292:        return;
                    293:    }
                    294: 
                    295:    // Le niveau 1 de la pile opérationnelle contient l'expression
                    296:    // à convertir.
                    297: 
                    298:    if (depilement(s_etat_processus, &(s_etat_processus
                    299:            ->l_base_pile), &s_objet) == d_erreur)
                    300:    {
                    301:        return;
                    302:    }
                    303: 
1.4       bertrand  304:    if ((s_objet->type == ALG) || (s_objet->type == RPN))
                    305:    {
                    306:        // On transcrit les fonctions de GIAC vers le RPL/2.
                    307: 
1.13      bertrand  308:        l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                    309:                s_objet->objet);
                    310:        drapeau = d_faux;
                    311: 
                    312:        // S'il y a une valeur infini, on force l'évaluation de l'expression.
                    313: 
                    314:        while(l_element_courant != NULL)
                    315:        {
                    316:            if (l_element_courant->donnee->type == NOM)
                    317:            {
                    318:                if (strcmp((const char *) reinterpret_cast<unsigned char *>(
                    319:                        reinterpret_cast<struct_nom *>(
                    320:                        l_element_courant->donnee->objet)->nom),
                    321:                        "infinity") == 0)
                    322:                {
                    323:                    drapeau = d_vrai;
                    324:                    break;
                    325:                }
                    326:            }
                    327: 
                    328:            l_element_courant = l_element_courant->suivant;
                    329:        }
                    330: 
                    331:        if (drapeau == d_vrai)
                    332:        {
                    333:            if (evaluation(s_etat_processus, s_objet, 'N') == d_erreur)
                    334:            {
                    335:                return;
                    336:            }
                    337: 
                    338:            liberation(s_etat_processus, s_objet);
                    339: 
                    340:            if (depilement(s_etat_processus, &(s_etat_processus
                    341:                    ->l_base_pile), &s_objet) == d_erreur)
                    342:            {
                    343:                return;
                    344:            }
                    345:        }
                    346:    }
                    347: 
                    348:    if ((s_objet->type == ALG) || (s_objet->type == RPN))
                    349:    {
1.4       bertrand  350:        l_element_courant = reinterpret_cast<struct_liste_chainee *>(
                    351:                s_objet->objet);
                    352: 
                    353:        while(l_element_courant != NULL)
                    354:        {
                    355:            if (l_element_courant->donnee->type == FCT)
                    356:            {
                    357:                // Nous sommes en présence d'un nom, donc de quelque chose
                    358:                // qui n'est pas reconnu comme un mot-clef du RPL/2. S'il
                    359:                // s'agit d'un mot-clef de GIAC, on le convertit.
                    360: 
1.12      bertrand  361:                if ((strcmp((const char *)
                    362:                        reinterpret_cast<struct_fonction *>(l_element_courant
                    363:                        ->donnee->objet)->nom_fonction, "quote") == 0) ||
                    364:                        (strcmp((const char *)
1.6       bertrand  365:                        reinterpret_cast<struct_fonction *>(l_element_courant
1.12      bertrand  366:                        ->donnee->objet)->nom_fonction, "nop") == 0))
1.4       bertrand  367:                {
                    368:                    liberation(s_etat_processus, l_element_courant->donnee);
                    369: 
                    370:                    if ((l_element_courant->donnee =
                    371:                            allocation(s_etat_processus, FCT)) == NULL)
                    372:                    {
                    373:                        s_etat_processus->erreur_systeme =
                    374:                                d_es_allocation_memoire;
                    375:                        return;
                    376:                    }
                    377: 
                    378:                    if ((((struct_fonction *) l_element_courant->donnee->objet)
                    379:                            ->nom_fonction = reinterpret_cast<unsigned char *>(
                    380:                            malloc(6 * sizeof(unsigned char))))
                    381:                            == NULL)
                    382:                    {
                    383:                        s_etat_processus->erreur_systeme =
                    384:                                d_es_allocation_memoire;
                    385:                        return;
                    386:                    }
                    387: 
1.6       bertrand  388:                    strcpy(reinterpret_cast<char *>(
                    389:                            reinterpret_cast<struct_fonction *>(
1.4       bertrand  390:                            l_element_courant->donnee->objet)->nom_fonction),
                    391:                            "RELAX");
                    392:                }
                    393:            }
                    394: 
                    395:            l_element_courant = l_element_courant->suivant;
                    396:        }
                    397:    }
                    398: 
1.13      bertrand  399:    if (empilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                    400:            s_objet) == d_erreur)
                    401:    {
                    402:        return;
                    403:    }
                    404: 
1.4       bertrand  405:    return;
                    406: }
1.19      bertrand  407: #endif
1.4       bertrand  408: 
                    409: 
1.1       bertrand  410: /*
                    411: ================================================================================
                    412:   Fonction 'interface_cas'
                    413: ================================================================================
1.4       bertrand  414:   Entrées : commande à effectuer.
                    415:   Le contrôle des types est effectué dans la fonction appelant interface_cas().
1.1       bertrand  416: --------------------------------------------------------------------------------
1.4       bertrand  417:   Sorties : retour par la pile.
1.1       bertrand  418: --------------------------------------------------------------------------------
                    419:   Effets de bord : néant
                    420: ================================================================================
                    421: */
                    422: 
1.42      bertrand  423: #pragma GCC diagnostic push
                    424: #pragma GCC diagnostic ignored "-Wunused-parameter"
1.3       bertrand  425: void
1.1       bertrand  426: interface_cas(struct_processus *s_etat_processus,
1.3       bertrand  427:        enum t_rplcas_commandes commande)
1.1       bertrand  428: {
1.42      bertrand  429: #ifdef RPLCAS
1.4       bertrand  430:    struct_objet            *s_objet_argument_1;
                    431:    struct_objet            *s_objet_argument_2;
1.12      bertrand  432:    struct_objet            *s_objet_temporaire;
                    433: 
                    434:    struct_liste_chainee    *l_element_courant;
1.4       bertrand  435: 
1.3       bertrand  436:    unsigned char           *argument_1;
1.4       bertrand  437:    unsigned char           *argument_2;
1.12      bertrand  438:    unsigned char           *argument_3;
                    439:    unsigned char           *argument_4;
1.3       bertrand  440: 
1.12      bertrand  441:    unsigned int            position;
                    442: 
1.14      bertrand  443:    giac::context           *contexte;
                    444: 
                    445:    if (s_etat_processus->contexte_cas == NULL)
                    446:    {
                    447:        try
                    448:        {
                    449:            s_etat_processus->contexte_cas = new giac::context;
                    450:        }
                    451:        catch(bad_alloc exception)
                    452:        {
                    453:            s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    454:            return;
                    455:        }
                    456:        catch(...)
                    457:        {
                    458:            s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
                    459:            return;
                    460:        }
                    461:    }
                    462: 
                    463:    contexte = reinterpret_cast<giac::context *>(
                    464:            s_etat_processus->contexte_cas);
                    465: 
                    466:    if ((s_etat_processus->erreur_execution != d_ex) ||
                    467:            (s_etat_processus->erreur_systeme != d_es))
                    468:    {
                    469:        return;
                    470:    }
                    471: 
1.3       bertrand  472:    switch(commande)
                    473:    {
1.4       bertrand  474:        case RPLCAS_INTEGRATION:
                    475:        {
                    476:            if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                    477:                    &s_objet_argument_1) == d_erreur)
                    478:            {
1.12      bertrand  479:                s_etat_processus->erreur_execution = d_ex_manque_argument;
1.4       bertrand  480:                return;
                    481:            }
                    482: 
                    483:            if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                    484:                    &s_objet_argument_2) == d_erreur)
                    485:            {
                    486:                liberation(s_etat_processus, s_objet_argument_1);
1.12      bertrand  487:                s_etat_processus->erreur_execution = d_ex_manque_argument;
1.4       bertrand  488:                return;
                    489:            }
                    490: 
                    491:            if ((argument_1 = conversion_rpl_vers_cas(s_etat_processus,
                    492:                    &s_objet_argument_1)) == NULL)
                    493:            {
                    494:                s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    495:                return;
                    496:            }
                    497: 
                    498:            if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
                    499:                    &s_objet_argument_2)) == NULL)
                    500:            {
                    501:                s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    502:                return;
                    503:            }
                    504: 
                    505:            liberation(s_etat_processus, s_objet_argument_1);
                    506:            liberation(s_etat_processus, s_objet_argument_2);
                    507: 
1.7       bertrand  508:            try
                    509:            {
                    510:                gen variable(
                    511:                        string(reinterpret_cast<const char *>(argument_1)),
1.14      bertrand  512:                        contexte);
1.7       bertrand  513:                gen expression(
                    514:                        string(reinterpret_cast<const char *>(argument_2)),
1.14      bertrand  515:                        contexte);
1.7       bertrand  516: 
1.14      bertrand  517:                gen resultat = integrate_gen(expression, variable,
                    518:                        contexte);
1.7       bertrand  519:                string chaine = "'" + resultat.print() + "'";
                    520: 
1.13      bertrand  521:                conversion_cas_vers_rpl(s_etat_processus,
                    522:                        reinterpret_cast<unsigned char *>(const_cast<char *>(
                    523:                        chaine.c_str())));
1.7       bertrand  524:            }
                    525:            catch(bad_alloc exception)
                    526:            {
                    527:                s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    528:            }
                    529:            catch(...)
1.4       bertrand  530:            {
1.7       bertrand  531:                s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
1.4       bertrand  532:            }
                    533: 
1.7       bertrand  534:            free(argument_1);
                    535:            free(argument_2);
1.4       bertrand  536: 
                    537:            break;
                    538:        }
                    539: 
1.3       bertrand  540:        case RPLCAS_LIMITE:
                    541:        {
1.12      bertrand  542:            if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                    543:                    &s_objet_argument_1) == d_erreur)
                    544:            {
                    545:                s_etat_processus->erreur_execution = d_ex_manque_argument;
                    546:                return;
                    547:            }
                    548: 
                    549:            if (depilement(s_etat_processus, &(s_etat_processus->l_base_pile),
                    550:                    &s_objet_argument_2) == d_erreur)
                    551:            {
                    552:                liberation(s_etat_processus, s_objet_argument_1);
                    553:                s_etat_processus->erreur_execution = d_ex_manque_argument;
                    554:                return;
                    555:            }
                    556: 
                    557:            // Fonction
                    558: 
                    559:            if ((argument_2 = conversion_rpl_vers_cas(s_etat_processus,
                    560:                    &s_objet_argument_2)) == NULL)
                    561:            {
                    562:                s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    563:                return;
                    564:            }
                    565: 
                    566:            // On parcourt la liste. Cette liste est tout d'abord copiée
                    567:            // car on est susceptible de modifier le second élément.
                    568: 
                    569:            if ((s_objet_temporaire = copie_objet(s_etat_processus,
                    570:                    s_objet_argument_1, 'O')) == NULL)
                    571:            {
                    572:                s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    573:                return;
                    574:            }
                    575: 
                    576:            liberation(s_etat_processus, s_objet_argument_1);
                    577:            s_objet_argument_1 = s_objet_temporaire;
                    578: 
                    579:            l_element_courant = reinterpret_cast<struct_liste_chainee *>
                    580:                    (s_objet_argument_1->objet);
                    581:            position = 1;
1.20      bertrand  582:            argument_1 = NULL;
                    583:            argument_3 = NULL;
1.12      bertrand  584:            argument_4 = NULL;
                    585: 
                    586:            while(l_element_courant != NULL)
                    587:            {
                    588:                switch(position)
                    589:                {
                    590:                    case 1:
                    591:                    {
                    592:                        // Variable
                    593: 
                    594:                        if ((argument_1 = reinterpret_cast<unsigned char *>
                    595:                                (malloc((strlen((const char *)
                    596:                                ((struct_variable *) (l_element_courant
                    597:                                ->donnee->objet))->nom)
                    598:                                + 1) * sizeof(unsigned char)))) == NULL)
                    599:                        {
                    600:                            s_etat_processus->erreur_systeme =
                    601:                                    d_es_allocation_memoire;
                    602:                            return;
                    603:                        }
                    604: 
                    605:                        strcpy(reinterpret_cast<char *>(argument_1),
                    606:                                (const char *) ((struct_variable *)
                    607:                                (l_element_courant->donnee->objet))->nom);
                    608:                        break;
                    609:                    }
                    610: 
                    611:                    case 2:
                    612:                    {
                    613:                        // Valeur
                    614:                        if ((argument_3 = conversion_rpl_vers_cas(
                    615:                                s_etat_processus,
                    616:                                &(l_element_courant->donnee))) == NULL)
                    617:                        {
                    618:                            s_etat_processus->erreur_systeme =
                    619:                                    d_es_allocation_memoire;
                    620:                            return;
                    621:                        }
                    622: 
                    623:                        break;
                    624:                    }
                    625: 
                    626:                    case 3:
                    627:                    {
                    628:                        // Direction
                    629: 
                    630:                        if ((argument_4 = reinterpret_cast<unsigned char *>
                    631:                                (malloc((strlen((const char *)
                    632:                                ((struct_fonction *) (l_element_courant
                    633:                                ->donnee->objet))->nom_fonction)
                    634:                                + 1) * sizeof(unsigned char)))) == NULL)
                    635:                        {
                    636:                            s_etat_processus->erreur_systeme =
                    637:                                    d_es_allocation_memoire;
                    638:                            return;
                    639:                        }
                    640: 
                    641:                        strcpy(reinterpret_cast<char *>(argument_4),
                    642:                                (const char *) ((struct_fonction *)
                    643:                                (l_element_courant->donnee->objet))
                    644:                                ->nom_fonction);
                    645:                        break;
                    646:                    }
                    647:                }
                    648: 
                    649:                l_element_courant = (*l_element_courant).suivant;
                    650:                position++;
                    651:            }
                    652: 
                    653:            liberation(s_etat_processus, s_objet_argument_1);
                    654:            liberation(s_etat_processus, s_objet_argument_2);
                    655: 
                    656:            try
                    657:            {
                    658:                int             direction;
                    659: 
                    660:                if (argument_4 == NULL)
                    661:                {
                    662:                    direction = 0;
                    663:                }
                    664:                else
                    665:                {
                    666:                    direction = (strcmp((const char *) argument_4, "+") == 0)
                    667:                            ? 1 : -1;
                    668:                }
                    669: 
                    670:                gen expression(
                    671:                        string(reinterpret_cast<const char *>(argument_2)),
1.14      bertrand  672:                        contexte);
1.12      bertrand  673:                identificateur variable(
                    674:                        string(reinterpret_cast<const char *>(argument_1)));
                    675:                gen valeur(string(reinterpret_cast<const char *>
1.14      bertrand  676:                        (argument_3)), contexte);
1.12      bertrand  677: 
                    678:                gen resultat = limit(expression, variable, valeur, direction,
1.14      bertrand  679:                        contexte);
1.12      bertrand  680:                string chaine = "'" + resultat.print() + "'";
                    681: 
1.13      bertrand  682:                conversion_cas_vers_rpl(s_etat_processus,
                    683:                        reinterpret_cast<unsigned char *>(const_cast<char *>(
                    684:                        chaine.c_str())));
1.12      bertrand  685:            }
                    686:            catch(bad_alloc exception)
                    687:            {
                    688:                s_etat_processus->erreur_systeme = d_es_allocation_memoire;
                    689:            }
                    690:            catch(...)
                    691:            {
                    692:                s_etat_processus->erreur_execution = d_ex_erreur_interne_rplcas;
                    693:            }
                    694: 
                    695:            free(argument_1);
                    696:            free(argument_2);
                    697:            free(argument_3);
                    698: 
                    699:            if (argument_4 != NULL)
                    700:            {
                    701:                free(argument_4);
                    702:            }
                    703: 
1.3       bertrand  704:            break;
                    705:        }
                    706:    }
1.1       bertrand  707: 
1.3       bertrand  708:    return;
1.9       bertrand  709: #else
                    710: 
                    711:    if (s_etat_processus->langue == 'F')
                    712:    {
                    713:        printf("+++Attention : RPL/CAS non compilé !\n");
                    714:    }
                    715:    else
                    716:    {
                    717:        printf("+++Warning : RPL/CAS not available !\n");
                    718:    }
                    719: 
                    720:    fflush(stdout);
                    721: 
                    722:    return;
                    723: 
                    724: #endif
1.1       bertrand  725: }
1.42      bertrand  726: #pragma GCC diagnostic pop
1.1       bertrand  727: 
                    728: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>