Annotation of rpl/src/instructions_t1.c, revision 1.46

1.1       bertrand    1: /*
                      2: ================================================================================
1.46    ! bertrand    3:   RPL/2 (R) version 4.1.14
1.43      bertrand    4:   Copyright (C) 1989-2013 Dr. BERTRAND Joël
1.1       bertrand    5: 
                      6:   This file is part of RPL/2.
                      7: 
                      8:   RPL/2 is free software; you can redistribute it and/or modify it
                      9:   under the terms of the CeCILL V2 License as published by the french
                     10:   CEA, CNRS and INRIA.
                     11:  
                     12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
                     13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
                     14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
                     15:   for more details.
                     16:  
                     17:   You should have received a copy of the CeCILL License
                     18:   along with RPL/2. If not, write to info@cecill.info.
                     19: ================================================================================
                     20: */
                     21: 
                     22: 
1.15      bertrand   23: #include "rpl-conv.h"
1.1       bertrand   24: 
                     25: 
                     26: /*
                     27: ================================================================================
                     28:   Fonction 'type'
                     29: ================================================================================
                     30:   Entrées : structure processus
                     31: --------------------------------------------------------------------------------
                     32:   Sorties :
                     33: --------------------------------------------------------------------------------
                     34:   Effets de bord : néant
                     35: ================================================================================
                     36: */
                     37: 
                     38: void
                     39: instruction_type(struct_processus *s_etat_processus)
                     40: {
                     41:    struct_objet                        *s_objet_argument;
                     42:    struct_objet                        *s_objet_resultat;
                     43: 
                     44:    (*s_etat_processus).erreur_execution = d_ex;
                     45: 
                     46:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     47:    {
                     48:        printf("\n  TYPE ");
                     49: 
                     50:        if ((*s_etat_processus).langue == 'F')
                     51:        {
                     52:            printf("(type d'objet)\n\n");
                     53:        }
                     54:        else
                     55:        {
                     56:            printf("(object type)\n\n");
                     57:        }
                     58: 
                     59:        printf("    1: %s, %s, %s, %s, %s, %s,\n"
                     60:                "       %s, %s, %s, %s, %s,\n"
                     61:                "       %s, %s, %s, %s, %s,\n"
                     62:                "       %s, %s, %s, %s\n",
                     63:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                     64:                d_TAB,
                     65:                d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB, d_SCK,
                     66:                d_PRC);
1.13      bertrand   67:        printf("->  1: %s\n\n", d_INT);
                     68: 
                     69:        if ((*s_etat_processus).langue == 'F')
                     70:        {
                     71:            printf("  Valeurs renvoyées : \n\n");
                     72:            printf("    0  : scalaire (entier ou réel)\n");
                     73:            printf("    1  : complexe\n");
                     74:            printf("    2  : chaîne de caractères\n");
                     75:            printf("    3  : vecteur ou matrice de scalaires\n");
                     76:            printf("    4  : vecteur ou matrice de complexes\n");
                     77:            printf("    5  : liste\n");
                     78:            printf("    6  : adresse\n");
                     79:            printf("    7  : nom\n");
                     80:            printf("    8  : expression en notation polonaire inversée\n");
                     81:            printf("    9  : expression algébrique\n");
                     82:            printf("    10 : entier binaire\n");
                     83:            printf("    11 : descripteur de fichier\n");
                     84:            printf("    12 : descripteur de bibliothèque partagée\n");
                     85:            printf("    13 : descripteur de socket\n");
                     86:            printf("    14 : processus\n");
                     87:            printf("    15 : fonction\n");
                     88:            printf("    16 : table\n");
                     89:        }
                     90:        else
                     91:        {
                     92:            printf("  Returned values : \n\n");
                     93:            printf("    0  : scalar, integer or real number\n");
                     94:            printf("    1  : complex\n");
                     95:            printf("    2  : string\n");
                     96:            printf("    3  : scalar vector or scalar matrix\n");
                     97:            printf("    4  : complex vector or complex matrix\n");
                     98:            printf("    5  : list\n");
                     99:            printf("    6  : address\n");
                    100:            printf("    7  : name\n");
                    101:            printf("    8  : RPN expression\n");
                    102:            printf("    9  : algebraic expression\n");
                    103:            printf("    10 : binary integer\n");
                    104:            printf("    11 : file descriptor\n");
                    105:            printf("    12 : shared library descriptor\n");
                    106:            printf("    13 : socket descriptor\n");
                    107:            printf("    14 : process\n");
                    108:            printf("    15 : function\n");
                    109:            printf("    16 : table\n");
                    110:        }
1.1       bertrand  111: 
                    112:        return;
                    113:    }
                    114:    else if ((*s_etat_processus).test_instruction == 'Y')
                    115:    {
                    116:        (*s_etat_processus).nombre_arguments = -1;
                    117:        return;
                    118:    }
                    119: 
                    120:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    121:    {
                    122:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    123:        {
                    124:            return;
                    125:        }
                    126:    }
                    127: 
                    128:    if (depilement(s_etat_processus, &((*s_etat_processus)
                    129:                .l_base_pile), &s_objet_argument) == d_erreur)
                    130:    {
                    131:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    132:        return;
                    133:    }
                    134: 
                    135:    if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
                    136:    {
                    137:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    138:        return;
                    139:    }
                    140: 
                    141:    if (((*s_objet_argument).type == INT) ||
                    142:            ((*s_objet_argument).type == REL))
                    143:    {
                    144:        (*((integer8 *) (*s_objet_resultat).objet)) = 0;
                    145:    }
                    146:    else if ((*s_objet_argument).type == CPL)
                    147:    {
                    148:        (*((integer8 *) (*s_objet_resultat).objet)) = 1;
                    149:    }
                    150:    else if ((*s_objet_argument).type == CHN)
                    151:    {
                    152:        (*((integer8 *) (*s_objet_resultat).objet)) = 2;
                    153:    }
                    154:    else if (((*s_objet_argument).type == VIN) ||
                    155:            ((*s_objet_argument).type == VRL) ||
                    156:            ((*s_objet_argument).type == MIN) ||
                    157:            ((*s_objet_argument).type == MRL))
                    158:    {
                    159:        (*((integer8 *) (*s_objet_resultat).objet)) = 3;
                    160:    }
                    161:    else if (((*s_objet_argument).type == VCX) ||
                    162:            ((*s_objet_argument).type == MCX))
                    163:    {
                    164:        (*((integer8 *) (*s_objet_resultat).objet)) = 4;
                    165:    }
                    166:    else if ((*s_objet_argument).type == LST)
                    167:    {
                    168:        (*((integer8 *) (*s_objet_resultat).objet)) = 5;
                    169:    }
                    170:    else if ((*s_objet_argument).type == ADR)
                    171:    {
                    172:        (*((integer8 *) (*s_objet_resultat).objet)) = 6;
                    173:    }
                    174:    else if ((*s_objet_argument).type == NOM)
                    175:    {
                    176:        (*((integer8 *) (*s_objet_resultat).objet)) = 7;
                    177:    }
                    178:    else if ((*s_objet_argument).type == RPN)
                    179:    {
                    180:        (*((integer8 *) (*s_objet_resultat).objet)) = 8;
                    181:    }
                    182:    else if ((*s_objet_argument).type == ALG)
                    183:    {
                    184:        (*((integer8 *) (*s_objet_resultat).objet)) = 9;
                    185:    }
                    186:    else if ((*s_objet_argument).type == BIN)
                    187:    {
                    188:        (*((integer8 *) (*s_objet_resultat).objet)) = 10;
                    189:    }
                    190:    else if ((*s_objet_argument).type == FCH)
                    191:    {
                    192:        (*((integer8 *) (*s_objet_resultat).objet)) = 11;
                    193:    }
                    194:    else if ((*s_objet_argument).type == SLB)
                    195:    {
                    196:        (*((integer8 *) (*s_objet_resultat).objet)) = 12;
                    197:    }
                    198:    else if ((*s_objet_argument).type == SCK)
                    199:    {
                    200:        (*((integer8 *) (*s_objet_resultat).objet)) = 13;
                    201:    }
                    202:    else if ((*s_objet_argument).type == PRC)
                    203:    {
                    204:        (*((integer8 *) (*s_objet_resultat).objet)) = 14;
                    205:    }
                    206:    else if ((*s_objet_argument).type == FCT)
                    207:    {
                    208:        (*((integer8 *) (*s_objet_resultat).objet)) = 15;
                    209:    }
                    210:    else if ((*s_objet_argument).type == TBL)
                    211:    {
                    212:        (*((integer8 *) (*s_objet_resultat).objet)) = 16;
                    213:    }
                    214:    else
                    215:    {
                    216:        /*
                    217:         * Les autres types de données sont des types internes
                    218:         */
                    219: 
                    220:        liberation(s_etat_processus, s_objet_argument);
                    221: 
                    222:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    223:        return;
                    224:    }   
                    225: 
                    226:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    227:            s_objet_resultat) == d_erreur)
                    228:    {
                    229:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    230:        return;
                    231:    }
                    232: 
                    233:    liberation(s_etat_processus, s_objet_argument);
                    234: 
                    235:    return;
                    236: }
                    237: 
                    238: 
                    239: /*
                    240: ================================================================================
                    241:   Fonction 'then'
                    242: ================================================================================
                    243:   Entrées : structure processus
                    244: --------------------------------------------------------------------------------
                    245:   Sorties :
                    246: --------------------------------------------------------------------------------
                    247:   Effets de bord : néant
                    248: ================================================================================
                    249: */
                    250: 
                    251: void
                    252: instruction_then(struct_processus *s_etat_processus)
                    253: {
                    254:    logical1                        condition;
                    255:    logical1                        drapeau_fin;
                    256:    logical1                        execution;
                    257: 
                    258:    struct_liste_chainee            *s_registre;
                    259: 
1.10      bertrand  260:    struct_liste_pile_systeme       *l_element_courant;
                    261: 
1.1       bertrand  262:    struct_objet                    *s_objet;
                    263: 
                    264:    unsigned char                   *instruction_majuscule;
                    265:    unsigned char                   *tampon;
                    266: 
1.45      bertrand  267:    integer8                        niveau;
1.1       bertrand  268: 
                    269:    void                            (*fonction)();
                    270: 
                    271:    (*s_etat_processus).erreur_execution = d_ex;
                    272: 
                    273:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    274:    {
                    275:        printf("\n  THEN ");
                    276: 
                    277:        if ((*s_etat_processus).langue == 'F')
                    278:        {
                    279:            printf("(structure de contrôle)\n\n");
                    280:            printf("  Utilisation :\n\n");
                    281:        }
                    282:        else
                    283:        {
                    284:            printf("(control statement)\n\n");
                    285:            printf("  Usage:\n\n");
                    286:        }
                    287: 
                    288:        printf("    IF(ERR)\n");
                    289:        printf("        (expression test 1)\n");
                    290:        printf("    THEN\n");
                    291:        printf("        (expression 1)\n");
                    292:        printf("    [ELSEIF\n");
                    293:        printf("        (expression test 2)\n");
                    294:        printf("    THEN\n");
                    295:        printf("        (expression 2)]\n");
                    296:        printf("    ...\n");
                    297:        printf("    [ELSE\n");
                    298:        printf("        (expression n)]\n");
                    299:        printf("    END\n\n");
                    300: 
                    301:        printf("    SELECT (expression test)\n");
                    302:        printf("        CASE (clause 1) THEN (expression 1) END\n");
                    303:        printf("        CASE (clause 2) THEN (expression 2) END\n");
                    304:        printf("        ...\n");
                    305:        printf("        CASE (clause n) THEN (expression n) END\n");
                    306:        printf("    DEFAULT\n");
                    307:        printf("        (expression)\n");
                    308:        printf("    END\n\n");
                    309: 
                    310:        printf("    SELECT (expression test)\n");
                    311:        printf("        CASE (clause 1) THEN (expression 1) END\n");
                    312:        printf("        (expression)\n");
                    313:        printf("        CASE (clause 2) THEN (expression 2) END\n");
                    314:        printf("    END\n");
                    315: 
                    316:        return;
                    317:    }
                    318:    else if ((*s_etat_processus).test_instruction == 'Y')
                    319:    {
                    320:        (*s_etat_processus).nombre_arguments = -1;
                    321:        return;
                    322:    }
                    323: 
                    324:    if (((*(*s_etat_processus).l_base_pile_systeme).clause != 'I') &&
                    325:        ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T') &&
                    326:        ((*(*s_etat_processus).l_base_pile_systeme).clause != 'R') &&
                    327:        ((*(*s_etat_processus).l_base_pile_systeme).clause != 'X') &&
                    328:        ((*(*s_etat_processus).l_base_pile_systeme).clause != 'C') &&
                    329:        ((*(*s_etat_processus).l_base_pile_systeme).clause != 'K'))
                    330:    {
                    331:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_condition;
                    332:        return;
                    333:    }
                    334: 
                    335:    /*
                    336:     * Traitement des erreurs
                    337:     */
                    338: 
                    339:    if (((*(*s_etat_processus).l_base_pile_systeme).clause == 'R') ||
                    340:            ((*(*s_etat_processus).l_base_pile_systeme).clause == 'X'))
                    341:    {
                    342:        if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
                    343:        {
                    344:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    345:            return;
                    346:        }
                    347: 
                    348:        if ((*(*s_etat_processus).l_base_pile_systeme).clause == 'R')
                    349:        {
                    350: 
                    351:            /*
                    352:             * Erreur à traiter : on saute jusques au ELSE ou au END
                    353:             * correspondant.
                    354:             */
                    355: 
                    356:            (*((integer8 *) (*s_objet).objet)) = 0;
                    357:        }
                    358:        else
                    359:        {
                    360:            (*((integer8 *) (*s_objet).objet)) = -1;
                    361:        }
                    362: 
                    363:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    364:                s_objet) == d_erreur)
                    365:        {
                    366:            return;
                    367:        }
                    368: 
                    369:        (*s_etat_processus).arret_si_exception = (*(*s_etat_processus)
                    370:                .l_base_pile_systeme).arret_si_exception;
                    371:    }
                    372: 
                    373:    /*
                    374:     * Traitement standard de l'instruction 'THEN'
                    375:     */
                    376: 
                    377:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    378:    {
                    379:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    380:        {
                    381:            return;
                    382:        }
                    383:    }
                    384: 
                    385:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    386:            &s_objet) == d_erreur)
                    387:    {
                    388:        return;
                    389:    }
                    390: 
1.12      bertrand  391:    if (((*s_objet).type == INT) || ((*s_objet).type == REL))
1.1       bertrand  392:    {
                    393:        if ((*s_objet).type == INT)
                    394:        {
                    395:            condition = ((*((integer8 *) (*s_objet).objet)) == 0)
                    396:                    ? d_faux : d_vrai;
                    397:        }
                    398:        else
                    399:        {
                    400:            condition = ((*((real8 *) (*s_objet).objet)) == 0)
                    401:                    ? d_faux : d_vrai;
                    402:        }
                    403: 
                    404:        if (condition == d_vrai)
                    405:        {
                    406: 
                    407:            /*
                    408:             * condition == d_vrai : exécution de ce qui se trouve entre
                    409:             * THEN et ELSE ou END.
                    410:             */
                    411: 
1.11      bertrand  412:            if (((*(*s_etat_processus).l_base_pile_systeme).clause ==
                    413:                    'I') || ((*(*s_etat_processus).l_base_pile_systeme).clause
1.12      bertrand  414:                    == 'X'))
1.1       bertrand  415:            {
                    416:                (*(*s_etat_processus).l_base_pile_systeme).clause = 'T';
                    417:            }
                    418:            else
                    419:            {
1.10      bertrand  420:                if ((*s_etat_processus).l_base_pile_systeme == NULL)
                    421:                {
                    422:                    (*s_etat_processus).erreur_systeme = d_es_pile_vide;
                    423:                    return;
                    424:                }
                    425: 
                    426:                l_element_courant = (*(*s_etat_processus).l_base_pile_systeme)
                    427:                        .suivant;
                    428: 
                    429:                while(l_element_courant != NULL)
                    430:                {
                    431:                    if ((*l_element_courant).clause == 'K')
                    432:                    {
                    433:                        (*l_element_courant).clause = 'Q';
                    434:                        break;
                    435:                    }
                    436: 
                    437:                    l_element_courant = (*l_element_courant).suivant;
                    438:                }
1.1       bertrand  439:            }
                    440:        }
                    441:        else
                    442:        {
                    443:            /*
                    444:             * condition == d_faux : saut à END ou exécution de ce qui se
                    445:             * trouve entre ELSE et END
                    446:             */
                    447: 
                    448:            if ((*(*s_etat_processus).l_base_pile_systeme).clause != 'T')
                    449:            {
                    450:                /*
                    451:                 * Traitement de ELSEIF
                    452:                 */
                    453: 
                    454:                if (((*(*s_etat_processus).l_base_pile_systeme).clause !=
                    455:                        'K') && ((*(*s_etat_processus).l_base_pile_systeme)
                    456:                        .clause != 'C'))
                    457:                {
                    458:                    (*(*s_etat_processus).l_base_pile_systeme).clause = 'E';
                    459:                }
                    460:            }
                    461: 
                    462:            niveau = 0;
                    463:            drapeau_fin = d_faux;
                    464: 
                    465:            if ((*s_etat_processus).mode_execution_programme == 'Y')
                    466:            {
                    467:                tampon = (*s_etat_processus).instruction_courante;
                    468: 
                    469:                do
                    470:                {
                    471:                    if (recherche_instruction_suivante(s_etat_processus)
                    472:                            == d_erreur)
                    473:                    {
                    474:                        liberation(s_etat_processus, s_objet);
                    475: 
                    476:                        if ((*s_etat_processus).instruction_courante != NULL)
                    477:                        {
                    478:                            free((*s_etat_processus).instruction_courante);
                    479:                        }
                    480: 
                    481:                        (*s_etat_processus).instruction_courante = tampon;
                    482:                        (*s_etat_processus).erreur_execution =
                    483:                                d_ex_erreur_traitement_condition;
                    484:                        return;
                    485:                    }
                    486: 
                    487:                    if ((instruction_majuscule = conversion_majuscule(
                    488:                            (*s_etat_processus).instruction_courante)) == NULL)
                    489:                    {
                    490:                        liberation(s_etat_processus, s_objet);
                    491: 
                    492:                        free((*s_etat_processus).instruction_courante);
                    493:                        (*s_etat_processus).instruction_courante = tampon;
                    494:                        (*s_etat_processus).erreur_systeme =
                    495:                                d_es_allocation_memoire;
                    496:                        return;
                    497:                    }
                    498: 
                    499:                    if (niveau == 0)
                    500:                    {
                    501:                        if (((*(*s_etat_processus).l_base_pile_systeme)
                    502:                                .clause != 'K') && ((*(*s_etat_processus)
                    503:                                .l_base_pile_systeme) .clause != 'C'))
                    504:                        {
                    505: 
                    506:                            /*
                    507:                             * Traitement de IF/THEN/ELSEIF/THEN/ELSE/END
                    508:                             */
                    509: 
                    510:                            if ((strcmp(instruction_majuscule, "END") == 0) ||
                    511:                                    (strcmp(instruction_majuscule, "ELSE")
                    512:                                    == 0) || (strcmp(instruction_majuscule,
                    513:                                    "ELSEIF") == 0))
                    514:                            {
                    515:                                (*s_etat_processus).position_courante
1.45      bertrand  516:                                        -= (integer8) (strlen(
                    517:                                        instruction_majuscule) + 1);
1.1       bertrand  518:                                drapeau_fin = d_vrai;
                    519:                            }
                    520:                            else
                    521:                            {
                    522:                                drapeau_fin = d_faux;
                    523:                            }
                    524:                        }
                    525:                        else
                    526:                        {
                    527:                            /*
                    528:                             * Traitement de CASE/THEN/END
                    529:                             */
                    530: 
                    531:                            if (strcmp(instruction_majuscule, "ELSE") == 0)
                    532:                            {
                    533:                                liberation(s_etat_processus, s_objet);
                    534: 
                    535:                                free((*s_etat_processus).instruction_courante);
                    536:                                free(instruction_majuscule);
                    537: 
                    538:                                (*s_etat_processus).instruction_courante =
                    539:                                        tampon;
                    540:                                (*s_etat_processus).erreur_execution =
                    541:                                        d_ex_erreur_traitement_condition;
                    542:                                return;
                    543:                            }
                    544:                            else if (strcmp(instruction_majuscule, "END") == 0)
                    545:                            {
1.10      bertrand  546:                                instruction_end(s_etat_processus);
1.1       bertrand  547:                                drapeau_fin = d_vrai;
                    548:                            }
                    549:                            else
                    550:                            {
                    551:                                drapeau_fin = d_faux;
                    552:                            }
                    553:                        }
                    554:                    }
                    555:                    else
                    556:                    {
                    557:                        drapeau_fin = d_faux;
                    558:                    }
                    559: 
                    560:                    if ((strcmp(instruction_majuscule, "CASE") == 0) ||
                    561:                            (strcmp(instruction_majuscule, "DO") == 0) ||
                    562:                            (strcmp(instruction_majuscule, "IF") == 0) ||
                    563:                            (strcmp(instruction_majuscule, "IFERR") == 0) ||
                    564:                            (strcmp(instruction_majuscule, "SELECT") == 0) ||
                    565:                            (strcmp(instruction_majuscule, "WHILE") == 0))
                    566:                    {
                    567:                        niveau++;
                    568:                    }
                    569:                    else if (strcmp(instruction_majuscule, "END") == 0)
                    570:                    {
                    571:                        niveau--;
                    572:                    }
                    573: 
                    574:                    free(instruction_majuscule);
                    575:                    free((*s_etat_processus).instruction_courante);
                    576:                } while(drapeau_fin == d_faux);
                    577: 
                    578:                (*s_etat_processus).instruction_courante = tampon;
                    579:            }
                    580:            else
                    581:            {
                    582:                /*
                    583:                 * Vérification du pointeur de prédiction de saut.
                    584:                 */
                    585: 
                    586:                if (pthread_mutex_lock(&((*(*(*s_etat_processus)
                    587:                        .expression_courante).donnee).mutex)) != 0)
                    588:                {
                    589:                    (*s_etat_processus).erreur_systeme = d_es_processus;
                    590:                    return;
                    591:                }
                    592: 
                    593:                if ((*((struct_fonction *) (*(*(*s_etat_processus)
                    594:                        .expression_courante).donnee).objet)).prediction_saut
                    595:                        != NULL)
                    596:                {
                    597:                    s_registre = (*s_etat_processus).expression_courante;
                    598: 
                    599:                    (*s_etat_processus).expression_courante =
                    600:                            (struct_liste_chainee *)
                    601:                            (*((struct_fonction *) (*(*(*s_etat_processus)
                    602:                            .expression_courante).donnee).objet))
                    603:                            .prediction_saut;
                    604:                    fonction = (*((struct_fonction *)
                    605:                            (*(*(*s_etat_processus).expression_courante)
                    606:                            .donnee).objet)).fonction;
                    607:                    execution = (*((struct_fonction *)
                    608:                            (*(*s_registre).donnee).objet))
                    609:                            .prediction_execution;
                    610: 
                    611:                    if (pthread_mutex_unlock(&((*(*s_registre).donnee).mutex))
                    612:                            != 0)
                    613:                    {
                    614:                        (*s_etat_processus).erreur_systeme = d_es_processus;
                    615:                        return;
                    616:                    }
                    617: 
                    618:                    if (execution == d_vrai)
                    619:                    {
                    620:                        fonction(s_etat_processus);
                    621:                    }
                    622:                }
                    623:                else
                    624:                {
                    625:                    if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
                    626:                            .expression_courante).donnee).mutex)) != 0)
                    627:                    {
                    628:                        (*s_etat_processus).erreur_systeme = d_es_processus;
                    629:                        return;
                    630:                    }
                    631: 
                    632:                    s_registre = (*s_etat_processus).expression_courante;
                    633:                    execution = d_faux;
                    634: 
                    635:                    do
                    636:                    {
                    637:                        if (((*s_etat_processus).expression_courante =
                    638:                                (*(*s_etat_processus).expression_courante)
                    639:                                .suivant) == NULL)
                    640:                        {
                    641:                            liberation(s_etat_processus, s_objet);
                    642:                            (*s_etat_processus).erreur_execution =
                    643:                                    d_ex_erreur_traitement_condition;
                    644:                            return;
                    645:                        }
                    646: 
                    647:                        if ((*(*(*s_etat_processus).expression_courante)
                    648:                                .donnee).type == FCT)
                    649:                        {
                    650:                            fonction = (*((struct_fonction *)
                    651:                                    (*(*(*s_etat_processus).expression_courante)
                    652:                                    .donnee).objet)).fonction;
                    653: 
                    654:                            if (niveau == 0)
                    655:                            {
                    656:                                if (((*(*s_etat_processus).l_base_pile_systeme)
                    657:                                        .clause != 'K') &&
                    658:                                        ((*(*s_etat_processus)
1.10      bertrand  659:                                        .l_base_pile_systeme).clause != 'C'))
1.1       bertrand  660:                                {
                    661:                                    /*
                    662:                                     * Traitement de IF/THEN/ELSEIF/THEN/
                    663:                                     * ELSE/END
                    664:                                     */
                    665: 
                    666:                                    if ((fonction == instruction_end) ||
                    667:                                            (fonction == instruction_else) ||
                    668:                                            (fonction == instruction_elseif))
                    669:                                    {
                    670:                                        fonction(s_etat_processus);
                    671:                                        execution = d_vrai;
                    672:                                        drapeau_fin = d_vrai;
                    673:                                    }
                    674:                                    else
                    675:                                    {
                    676:                                        drapeau_fin = d_faux;
                    677:                                    }
                    678:                                }
                    679:                                else
                    680:                                {
                    681:                                    /*
                    682:                                     * Traitement de CASE/THEN/END
                    683:                                     */
                    684: 
                    685:                                    if (fonction == instruction_else)
                    686:                                    {
                    687:                                        liberation(s_etat_processus, s_objet);
                    688: 
                    689:                                        if ((drapeau_fin == d_faux) &&
                    690:                                                ((*s_etat_processus)
                    691:                                                .expression_courante != NULL))
                    692:                                        {
                    693:                                            (*s_etat_processus)
                    694:                                                    .expression_courante
                    695:                                                    = (*(*s_etat_processus)
                    696:                                                    .expression_courante)
                    697:                                                    .suivant;
                    698:                                        }
                    699: 
                    700:                                        (*s_etat_processus).erreur_execution =
                    701:                                            d_ex_erreur_traitement_condition;
                    702:                                        return;
                    703:                                    }
                    704:                                    else if (fonction == instruction_end)
                    705:                                    {
1.10      bertrand  706:                                        fonction(s_etat_processus);
                    707:                                        execution = d_vrai;
1.1       bertrand  708:                                        drapeau_fin = d_vrai;
                    709:                                    }
                    710:                                    else
                    711:                                    {
                    712:                                        drapeau_fin = d_faux;
                    713:                                    }
                    714:                                }
                    715:                            }
                    716:                            else
                    717:                            {
                    718:                                drapeau_fin = d_faux;
                    719:                            }
                    720: 
                    721:                            if ((fonction == instruction_case) ||
                    722:                                    (fonction == instruction_do) ||
                    723:                                    (fonction == instruction_if) ||
                    724:                                    (fonction == instruction_iferr) ||
                    725:                                    (fonction == instruction_select) ||
                    726:                                    (fonction == instruction_while))
                    727:                            {
                    728:                                niveau++;
                    729:                            }
                    730:                            else if (fonction == instruction_end)
                    731:                            {
                    732:                                niveau--;
                    733:                            }
                    734:                        }
                    735:                    } while(drapeau_fin == d_faux);
                    736: 
                    737:                    if (pthread_mutex_lock(&((*(*(*s_etat_processus)
                    738:                            .expression_courante).donnee).mutex)) != 0)
                    739:                    {
                    740:                        (*s_etat_processus).erreur_systeme = d_es_processus;
                    741:                        return;
                    742:                    }
                    743: 
                    744:                    (*((struct_fonction *) (*(*s_registre).donnee).objet))
                    745:                            .prediction_saut = (*s_etat_processus)
                    746:                            .expression_courante;
                    747:                    (*((struct_fonction *) (*(*s_registre).donnee).objet))
                    748:                            .prediction_execution = execution;
                    749: 
                    750:                    if (pthread_mutex_unlock(&((*(*(*s_etat_processus)
                    751:                            .expression_courante).donnee).mutex)) != 0)
                    752:                    {
                    753:                        (*s_etat_processus).erreur_systeme = d_es_processus;
                    754:                        return;
                    755:                    }
                    756:                }
                    757:            }
                    758:        }
                    759:    }
                    760:    else
                    761:    {
                    762:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    763:        return;
                    764:    }
                    765: 
                    766:    liberation(s_etat_processus, s_objet);
                    767:    return;
                    768: }
                    769: 
                    770: 
                    771: /*
                    772: ================================================================================
                    773:   Fonction 'tan'
                    774: ================================================================================
                    775:   Entrées : pointeur sur une structure struct_processus
                    776: --------------------------------------------------------------------------------
                    777:   Sorties :
                    778: --------------------------------------------------------------------------------
                    779:   Effets de bord : néant
                    780: ================================================================================
                    781: */
                    782: 
                    783: void
                    784: instruction_tan(struct_processus *s_etat_processus)
                    785: {
                    786:    real8                           angle;
                    787: 
                    788:    integer4                        erreur;
                    789: 
                    790:    struct_liste_chainee            *l_element_courant;
                    791:    struct_liste_chainee            *l_element_precedent;
                    792: 
                    793:    struct_objet                    *s_copie_argument;
                    794:    struct_objet                    *s_objet_argument;
                    795:    struct_objet                    *s_objet_resultat;
                    796: 
                    797:    (*s_etat_processus).erreur_execution = d_ex;
                    798: 
                    799:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    800:    {
                    801:        printf("\n  TAN ");
                    802: 
                    803:        if ((*s_etat_processus).langue == 'F')
                    804:        {
                    805:            printf("(tangente)\n\n");
                    806:        }
                    807:        else
                    808:        {
                    809:            printf("(tangent)\n\n");
                    810:        }
                    811: 
                    812:        printf("    1: %s, %s\n", d_INT, d_REL);
                    813:        printf("->  1: %s\n\n", d_REL);
                    814: 
                    815:        printf("    1: %s\n", d_CPL);
                    816:        printf("->  1: %s\n\n", d_CPL);
                    817: 
                    818:        printf("    1: %s, %s\n", d_NOM, d_ALG);
                    819:        printf("->  1: %s\n\n", d_ALG);
                    820: 
                    821:        printf("    1: %s\n", d_RPN);
                    822:        printf("->  1: %s\n", d_RPN);
                    823: 
                    824:        return;
                    825:    }
                    826:    else if ((*s_etat_processus).test_instruction == 'Y')
                    827:    {
                    828:        (*s_etat_processus).nombre_arguments = 1;
                    829:        return;
                    830:    }
                    831: 
                    832:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    833:    {
                    834:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    835:        {
                    836:            return;
                    837:        }
                    838:    }
                    839: 
                    840:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    841:            &s_objet_argument) == d_erreur)
                    842:    {
                    843:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    844:        return;
                    845:    }
                    846: 
                    847: /*
                    848: --------------------------------------------------------------------------------
                    849:   Tangente d'un entier ou d'un réel
                    850: --------------------------------------------------------------------------------
                    851: */
                    852: 
                    853:    if (((*s_objet_argument).type == INT) ||
                    854:            ((*s_objet_argument).type == REL))
                    855:    {
                    856:        if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
                    857:        {
                    858:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    859:            return;
                    860:        }
                    861: 
                    862:        if ((*s_objet_argument).type == INT)
                    863:        {
                    864:            angle = (real8) (*((integer8 *) (*s_objet_argument).objet));
                    865:        }
                    866:        else
                    867:        {
                    868:            angle = (*((real8 *) (*s_objet_argument).objet));
                    869:        }
                    870: 
                    871:        if (test_cfsf(s_etat_processus, 60) == d_faux)
                    872:        {
                    873:            conversion_degres_vers_radians(&angle);
                    874:        }
                    875: 
                    876:        if ((cos(angle) == 0) && (test_cfsf(s_etat_processus, 59) == d_vrai))
                    877:        {
                    878:            liberation(s_etat_processus, s_objet_argument);
                    879:            liberation(s_etat_processus, s_objet_resultat);
                    880: 
                    881:            (*s_etat_processus).exception = d_ep_division_par_zero;
                    882:            return;
                    883:        }
                    884: 
                    885:        (*((real8 *) (*s_objet_resultat).objet)) = tan(angle);
                    886:    }
                    887: 
                    888: /*
                    889: --------------------------------------------------------------------------------
                    890:   Tangente d'un complexe
                    891: --------------------------------------------------------------------------------
                    892: */
                    893: 
                    894:    else if ((*s_objet_argument).type == CPL)
                    895:    {
                    896:        if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
                    897:        {
                    898:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    899:            return;
                    900:        }
                    901: 
                    902:        f77tan_((struct_complexe16 *) (*s_objet_argument).objet,
                    903:                (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
                    904: 
                    905:        if (erreur != 0)
                    906:        {
                    907:            liberation(s_etat_processus, s_objet_argument);
                    908:            liberation(s_etat_processus, s_objet_resultat);
                    909: 
                    910:            (*s_etat_processus).exception = d_ep_division_par_zero;
                    911:            return;
                    912:        }
                    913:    }
                    914: 
                    915: /*
                    916: --------------------------------------------------------------------------------
                    917:   Tangente d'un nom
                    918: --------------------------------------------------------------------------------
                    919: */
                    920: 
                    921:    else if ((*s_objet_argument).type == NOM)
                    922:    {
                    923:        if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
                    924:        {
                    925:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    926:            return;
                    927:        }
                    928: 
                    929:        if (((*s_objet_resultat).objet =
                    930:                allocation_maillon(s_etat_processus)) == NULL)
                    931:        {
                    932:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    933:            return;
                    934:        }
                    935: 
                    936:        l_element_courant = (*s_objet_resultat).objet;
                    937: 
                    938:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                    939:                == NULL)
                    940:        {
                    941:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    942:            return;
                    943:        }
                    944: 
                    945:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    946:                .nombre_arguments = 0;
                    947:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    948:                .fonction = instruction_vers_niveau_superieur;
                    949: 
                    950:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    951:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                    952:        {
                    953:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    954:            return;
                    955:        }
                    956: 
                    957:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    958:                .nom_fonction, "<<");
                    959: 
                    960:        if (((*l_element_courant).suivant =
                    961:                allocation_maillon(s_etat_processus)) == NULL)
                    962:        {
                    963:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    964:            return;
                    965:        }
                    966: 
                    967:        l_element_courant = (*l_element_courant).suivant;
                    968:        (*l_element_courant).donnee = s_objet_argument;
                    969: 
                    970:        if (((*l_element_courant).suivant =
                    971:                allocation_maillon(s_etat_processus)) == NULL)
                    972:        {
                    973:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    974:            return;
                    975:        }
                    976: 
                    977:        l_element_courant = (*l_element_courant).suivant;
                    978: 
                    979:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                    980:                == NULL)
                    981:        {
                    982:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    983:            return;
                    984:        }
                    985: 
                    986:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    987:                .nombre_arguments = 1;
                    988:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    989:                .fonction = instruction_tan;
                    990: 
                    991:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    992:                .nom_fonction = malloc(4 * sizeof(unsigned char))) == NULL)
                    993:        {
                    994:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    995:            return;
                    996:        }
                    997: 
                    998:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    999:                .nom_fonction, "TAN");
                   1000: 
                   1001:        if (((*l_element_courant).suivant =
                   1002:                allocation_maillon(s_etat_processus)) == NULL)
                   1003:        {
                   1004:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1005:            return;
                   1006:        }
                   1007: 
                   1008:        l_element_courant = (*l_element_courant).suivant;
                   1009: 
                   1010:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   1011:                == NULL)
                   1012:        {
                   1013:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1014:            return;
                   1015:        }
                   1016: 
                   1017:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1018:                .nombre_arguments = 0;
                   1019:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1020:                .fonction = instruction_vers_niveau_inferieur;
                   1021: 
                   1022:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1023:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   1024:        {
                   1025:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1026:            return;
                   1027:        }
                   1028: 
                   1029:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1030:                .nom_fonction, ">>");
                   1031: 
                   1032:        (*l_element_courant).suivant = NULL;
                   1033:        s_objet_argument = NULL;
                   1034:    }
                   1035: 
                   1036: /*
                   1037: --------------------------------------------------------------------------------
                   1038:   Tangente d'une expression
                   1039: --------------------------------------------------------------------------------
                   1040: */
                   1041: 
                   1042:    else if (((*s_objet_argument).type == ALG) ||
                   1043:            ((*s_objet_argument).type == RPN))
                   1044:    {
                   1045:        if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
                   1046:                'N')) == NULL)
                   1047:        {
                   1048:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1049:            return;
                   1050:        }
                   1051: 
                   1052:        l_element_courant = (struct_liste_chainee *)
                   1053:                (*s_copie_argument).objet;
                   1054:        l_element_precedent = l_element_courant;
                   1055: 
                   1056:        while((*l_element_courant).suivant != NULL)
                   1057:        {
                   1058:            l_element_precedent = l_element_courant;
                   1059:            l_element_courant = (*l_element_courant).suivant;
                   1060:        }
                   1061: 
                   1062:        if (((*l_element_precedent).suivant =
                   1063:                allocation_maillon(s_etat_processus)) == NULL)
                   1064:        {
                   1065:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1066:            return;
                   1067:        }
                   1068: 
                   1069:        if (((*(*l_element_precedent).suivant).donnee =
                   1070:                allocation(s_etat_processus, FCT)) == NULL)
                   1071:        {
                   1072:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1073:            return;
                   1074:        }
                   1075: 
                   1076:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   1077:                .donnee).objet)).nombre_arguments = 1;
                   1078:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   1079:                .donnee).objet)).fonction = instruction_tan;
                   1080: 
                   1081:        if (((*((struct_fonction *) (*(*(*l_element_precedent)
                   1082:                .suivant).donnee).objet)).nom_fonction =
                   1083:                malloc(4 * sizeof(unsigned char))) == NULL)
                   1084:        {
                   1085:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1086:            return;
                   1087:        }
                   1088: 
                   1089:        strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
                   1090:                .suivant).donnee).objet)).nom_fonction, "TAN");
                   1091: 
                   1092:        (*(*l_element_precedent).suivant).suivant = l_element_courant;
                   1093: 
                   1094:        s_objet_resultat = s_copie_argument;
                   1095:    }
                   1096: 
                   1097: /*
                   1098: --------------------------------------------------------------------------------
                   1099:   Réalisation impossible de la fonction tangente
                   1100: --------------------------------------------------------------------------------
                   1101: */
                   1102: 
                   1103:    else
                   1104:    {
                   1105:        liberation(s_etat_processus, s_objet_argument);
                   1106: 
                   1107:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1108:        return;
                   1109:    }
                   1110: 
                   1111:    liberation(s_etat_processus, s_objet_argument);
                   1112: 
                   1113:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1114:            s_objet_resultat) == d_erreur)
                   1115:    {
                   1116:        return;
                   1117:    }
                   1118: 
                   1119:    return;
                   1120: }
                   1121: 
                   1122: 
                   1123: /*
                   1124: ================================================================================
                   1125:   Fonction 'tanh'
                   1126: ================================================================================
                   1127:   Entrées : pointeur sur une structure struct_processus
                   1128: --------------------------------------------------------------------------------
                   1129:   Sorties :
                   1130: --------------------------------------------------------------------------------
                   1131:   Effets de bord : néant
                   1132: ================================================================================
                   1133: */
                   1134: 
                   1135: void
                   1136: instruction_tanh(struct_processus *s_etat_processus)
                   1137: {
                   1138:    real8                           argument;
                   1139: 
                   1140:    integer4                        erreur;
                   1141: 
                   1142:    struct_liste_chainee            *l_element_courant;
                   1143:    struct_liste_chainee            *l_element_precedent;
                   1144: 
                   1145:    struct_objet                    *s_copie_argument;
                   1146:    struct_objet                    *s_objet_argument;
                   1147:    struct_objet                    *s_objet_resultat;
                   1148: 
                   1149:    (*s_etat_processus).erreur_execution = d_ex;
                   1150: 
                   1151:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1152:    {
                   1153:        printf("\n  TANH ");
                   1154: 
                   1155:        if ((*s_etat_processus).langue == 'F')
                   1156:        {
                   1157:            printf("(tangente hyperbolique)\n\n");
                   1158:        }
                   1159:        else
                   1160:        {
                   1161:            printf("(hyperbolic tangent)\n\n");
                   1162:        }
                   1163: 
                   1164:        printf("    1: %s, %s\n", d_INT, d_REL);
                   1165:        printf("->  1: %s\n\n", d_INT);
                   1166: 
                   1167:        printf("    1: %s\n", d_CPL);
                   1168:        printf("->  1: %s\n\n", d_CPL);
                   1169: 
                   1170:        printf("    1: %s, %s\n", d_NOM, d_ALG);
                   1171:        printf("->  1: %s\n\n", d_ALG);
                   1172: 
                   1173:        printf("    1: %s\n", d_RPN);
                   1174:        printf("->  1: %s\n", d_RPN);
                   1175: 
                   1176:        return;
                   1177:    }
                   1178:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1179:    {
                   1180:        (*s_etat_processus).nombre_arguments = 1;
                   1181:        return;
                   1182:    }
                   1183: 
                   1184:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                   1185:    {
                   1186:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                   1187:        {
                   1188:            return;
                   1189:        }
                   1190:    }
                   1191: 
                   1192:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1193:            &s_objet_argument) == d_erreur)
                   1194:    {
                   1195:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                   1196:        return;
                   1197:    }
                   1198: 
                   1199: /*
                   1200: --------------------------------------------------------------------------------
                   1201:   Tangente hyperbolique d'un entier ou d'un réel
                   1202: --------------------------------------------------------------------------------
                   1203: */
                   1204: 
                   1205:    if (((*s_objet_argument).type == INT) ||
                   1206:            ((*s_objet_argument).type == REL))
                   1207:    {
                   1208:        if ((s_objet_resultat = allocation(s_etat_processus, REL)) == NULL)
                   1209:        {
                   1210:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1211:            return;
                   1212:        }
                   1213: 
                   1214:        if ((*s_objet_argument).type == INT)
                   1215:        {
                   1216:            argument = (real8) (*((integer8 *) (*s_objet_argument).objet));
                   1217:        }
                   1218:        else
                   1219:        {
                   1220:            argument = (*((real8 *) (*s_objet_argument).objet));
                   1221:        }
                   1222: 
                   1223:        (*((real8 *) (*s_objet_resultat).objet)) = tanh(argument);
                   1224:    }
                   1225: 
                   1226: /*
                   1227: --------------------------------------------------------------------------------
                   1228:   Tangente hyperbolique d'un complexe
                   1229: --------------------------------------------------------------------------------
                   1230: */
                   1231: 
                   1232:    else if ((*s_objet_argument).type == CPL)
                   1233:    {
                   1234:        if ((s_objet_resultat = allocation(s_etat_processus, CPL)) == NULL)
                   1235:        {
                   1236:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1237:            return;
                   1238:        }
                   1239: 
                   1240:        f77tanh_((struct_complexe16 *) (*s_objet_argument).objet,
                   1241:                (struct_complexe16 *) (*s_objet_resultat).objet, &erreur);
                   1242: 
                   1243:        if (erreur != 0)
                   1244:        {
                   1245:            liberation(s_etat_processus, s_objet_argument);
                   1246:            liberation(s_etat_processus, s_objet_resultat);
                   1247: 
                   1248:            (*s_etat_processus).exception = d_ep_division_par_zero;
                   1249:            return;
                   1250:        }
                   1251:    }
                   1252: 
                   1253: /*
                   1254: --------------------------------------------------------------------------------
                   1255:   Tangente hyperbolique d'un nom
                   1256: --------------------------------------------------------------------------------
                   1257: */
                   1258: 
                   1259:    else if ((*s_objet_argument).type == NOM)
                   1260:    {
                   1261:        if ((s_objet_resultat = allocation(s_etat_processus, ALG)) == NULL)
                   1262:        {
                   1263:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1264:            return;
                   1265:        }
                   1266: 
                   1267:        if (((*s_objet_resultat).objet =
                   1268:                allocation_maillon(s_etat_processus)) == NULL)
                   1269:        {
                   1270:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1271:            return;
                   1272:        }
                   1273: 
                   1274:        l_element_courant = (*s_objet_resultat).objet;
                   1275: 
                   1276:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   1277:                == NULL)
                   1278:        {
                   1279:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1280:            return;
                   1281:        }
                   1282: 
                   1283:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1284:                .nombre_arguments = 0;
                   1285:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1286:                .fonction = instruction_vers_niveau_superieur;
                   1287: 
                   1288:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1289:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   1290:        {
                   1291:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1292:            return;
                   1293:        }
                   1294: 
                   1295:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1296:                .nom_fonction, "<<");
                   1297: 
                   1298:        if (((*l_element_courant).suivant =
                   1299:                allocation_maillon(s_etat_processus)) == NULL)
                   1300:        {
                   1301:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1302:            return;
                   1303:        }
                   1304: 
                   1305:        l_element_courant = (*l_element_courant).suivant;
                   1306:        (*l_element_courant).donnee = s_objet_argument;
                   1307: 
                   1308:        if (((*l_element_courant).suivant =
                   1309:                allocation_maillon(s_etat_processus)) == NULL)
                   1310:        {
                   1311:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1312:            return;
                   1313:        }
                   1314: 
                   1315:        l_element_courant = (*l_element_courant).suivant;
                   1316: 
                   1317:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   1318:                == NULL)
                   1319:        {
                   1320:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1321:            return;
                   1322:        }
                   1323: 
                   1324:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1325:                .nombre_arguments = 1;
                   1326:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1327:                .fonction = instruction_tanh;
                   1328: 
                   1329:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1330:                .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
                   1331:        {
                   1332:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1333:            return;
                   1334:        }
                   1335: 
                   1336:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1337:                .nom_fonction, "TANH");
                   1338: 
                   1339:        if (((*l_element_courant).suivant =
                   1340:                allocation_maillon(s_etat_processus)) == NULL)
                   1341:        {
                   1342:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1343:            return;
                   1344:        }
                   1345: 
                   1346:        l_element_courant = (*l_element_courant).suivant;
                   1347: 
                   1348:        if (((*l_element_courant).donnee = allocation(s_etat_processus, FCT))
                   1349:                == NULL)
                   1350:        {
                   1351:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1352:            return;
                   1353:        }
                   1354: 
                   1355:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1356:                .nombre_arguments = 0;
                   1357:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1358:                .fonction = instruction_vers_niveau_inferieur;
                   1359: 
                   1360:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1361:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                   1362:        {
                   1363:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1364:            return;
                   1365:        }
                   1366: 
                   1367:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                   1368:                .nom_fonction, ">>");
                   1369: 
                   1370:        (*l_element_courant).suivant = NULL;
                   1371:        s_objet_argument = NULL;
                   1372:    }
                   1373: 
                   1374: /*
                   1375: --------------------------------------------------------------------------------
                   1376:   Tangente hyperbolique d'une expression
                   1377: --------------------------------------------------------------------------------
                   1378: */
                   1379: 
                   1380:    else if (((*s_objet_argument).type == ALG) ||
                   1381:            ((*s_objet_argument).type == RPN))
                   1382:    {
                   1383:        if ((s_copie_argument = copie_objet(s_etat_processus, s_objet_argument,
                   1384:                'N')) == NULL)
                   1385:        {
                   1386:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1387:            return;
                   1388:        }
                   1389: 
                   1390:        l_element_courant = (struct_liste_chainee *)
                   1391:                (*s_copie_argument).objet;
                   1392:        l_element_precedent = l_element_courant;
                   1393: 
                   1394:        while((*l_element_courant).suivant != NULL)
                   1395:        {
                   1396:            l_element_precedent = l_element_courant;
                   1397:            l_element_courant = (*l_element_courant).suivant;
                   1398:        }
                   1399: 
                   1400:        if (((*l_element_precedent).suivant =
                   1401:                allocation_maillon(s_etat_processus)) == NULL)
                   1402:        {
                   1403:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1404:            return;
                   1405:        }
                   1406: 
                   1407:        if (((*(*l_element_precedent).suivant).donnee =
                   1408:                allocation(s_etat_processus, FCT)) == NULL)
                   1409:        {
                   1410:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1411:            return;
                   1412:        }
                   1413: 
                   1414:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   1415:                .donnee).objet)).nombre_arguments = 1;
                   1416:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                   1417:                .donnee).objet)).fonction = instruction_tanh;
                   1418: 
                   1419:        if (((*((struct_fonction *) (*(*(*l_element_precedent)
                   1420:                .suivant).donnee).objet)).nom_fonction =
                   1421:                malloc(5 * sizeof(unsigned char))) == NULL)
                   1422:        {
                   1423:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1424:            return;
                   1425:        }
                   1426: 
                   1427:        strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
                   1428:                .suivant).donnee).objet)).nom_fonction, "TANH");
                   1429: 
                   1430:        (*(*l_element_precedent).suivant).suivant = l_element_courant;
                   1431: 
                   1432:        s_objet_resultat = s_copie_argument;
                   1433:    }
                   1434: 
                   1435: /*
                   1436: --------------------------------------------------------------------------------
                   1437:   Réalisation impossible de la fonction tangente hyperbolique
                   1438: --------------------------------------------------------------------------------
                   1439: */
                   1440: 
                   1441:    else
                   1442:    {
                   1443:        liberation(s_etat_processus, s_objet_argument);
                   1444: 
                   1445:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                   1446:        return;
                   1447:    }
                   1448: 
                   1449:    liberation(s_etat_processus, s_objet_argument);
                   1450: 
                   1451:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1452:            s_objet_resultat) == d_erreur)
                   1453:    {
                   1454:        return;
                   1455:    }
                   1456: 
                   1457:    return;
                   1458: }
                   1459: 
                   1460: 
                   1461: /*
                   1462: ================================================================================
                   1463:   Fonction 'true'
                   1464: ================================================================================
                   1465:   Entrées : structure processus
                   1466: --------------------------------------------------------------------------------
                   1467:   Sorties :
                   1468: --------------------------------------------------------------------------------
                   1469:   Effets de bord : néant
                   1470: ================================================================================
                   1471: */
                   1472: 
                   1473: void
                   1474: instruction_true(struct_processus *s_etat_processus)
                   1475: {
                   1476:    struct_objet                    *s_objet;
                   1477: 
                   1478:    if ((*s_etat_processus).affichage_arguments == 'Y')
                   1479:    {
                   1480:        printf("\n  TRUE ");
                   1481: 
                   1482:        if ((*s_etat_processus).langue == 'F')
                   1483:        {
                   1484:            printf("(valeur vraie)\n\n");
                   1485:        }
                   1486:        else
                   1487:        {
                   1488:            printf("(true value)\n\n");
                   1489:        }
                   1490: 
                   1491:        printf("->  1: %s\n", d_INT);
                   1492: 
                   1493:        return;
                   1494:    }
                   1495:    else if ((*s_etat_processus).test_instruction == 'Y')
                   1496:    {
                   1497:        (*s_etat_processus).nombre_arguments = -1;
                   1498:        return;
                   1499:    }
                   1500: 
                   1501:    if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
                   1502:    {
                   1503:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                   1504:        return;
                   1505:    }
                   1506: 
                   1507:    (*((integer8 *) (*s_objet).objet)) = -1;
                   1508: 
                   1509:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                   1510:            s_objet) == d_erreur)
                   1511:    {
                   1512:        return;
                   1513:    }
                   1514: 
                   1515:    return;
                   1516: }
                   1517: 
                   1518: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>