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

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

CVSweb interface <joel.bertrand@systella.fr>