Annotation of rpl/src/instructions_a3.c, revision 1.57

1.1       bertrand    1: /*
                      2: ================================================================================
1.56      bertrand    3:   RPL/2 (R) version 4.1.26
1.57    ! bertrand    4:   Copyright (C) 1989-2017 Dr. BERTRAND Joël
1.1       bertrand    5: 
                      6:   This file is part of RPL/2.
                      7: 
                      8:   RPL/2 is free software; you can redistribute it and/or modify it
                      9:   under the terms of the CeCILL V2 License as published by the french
                     10:   CEA, CNRS and INRIA.
                     11:  
                     12:   RPL/2 is distributed in the hope that it will be useful, but WITHOUT
                     13:   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
                     14:   FITNESS FOR A PARTICULAR PURPOSE.  See the CeCILL V2 License
                     15:   for more details.
                     16:  
                     17:   You should have received a copy of the CeCILL License
                     18:   along with RPL/2. If not, write to info@cecill.info.
                     19: ================================================================================
                     20: */
                     21: 
                     22: 
1.11      bertrand   23: #include "rpl-conv.h"
1.1       bertrand   24: 
                     25: 
                     26: /*
                     27: ================================================================================
                     28:   Fonction 'array->'
                     29: ================================================================================
                     30:   Entrées : pointeur sur une structure struct_processus
                     31: --------------------------------------------------------------------------------
                     32:   Sorties :
                     33: --------------------------------------------------------------------------------
                     34:   Effets de bord : néant
                     35: ================================================================================
                     36: */
                     37: 
                     38: void
                     39: instruction_array_fleche(struct_processus *s_etat_processus)
                     40: {
1.41      bertrand   41:    integer8                        i;
                     42:    integer8                        j;
                     43: 
1.1       bertrand   44:    struct_liste_chainee            *l_element_courant;
                     45: 
                     46:    struct_objet                    *s_objet_source;
                     47:    struct_objet                    *s_objet_elementaire;
                     48: 
                     49:    (*s_etat_processus).erreur_execution = d_ex;
                     50: 
                     51:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     52:    {
                     53:        printf("\n  ARRAY-> [ARRY->] ");
                     54: 
                     55:        if ((*s_etat_processus).langue == 'F')
                     56:        {
                     57:            printf("(éclatement de vecteur ou de matrice)\n\n");
                     58:        }
                     59:        else
                     60:        {
                     61:            printf("(vector or matrix split)\n\n");
                     62:        }
                     63: 
                     64:        printf("    1: %s\n", d_VIN);
                     65:        printf("->  n: %s\n", d_INT);
                     66:        printf("    ...\n");
                     67:        printf("    1: %s\n\n", d_INT);
                     68: 
                     69:        printf("    1: %s\n", d_VRL);
                     70:        printf("->  n: %s\n", d_REL);
                     71:        printf("    ...\n");
                     72:        printf("    1: %s\n\n", d_REL);
                     73: 
                     74:        printf("    1: %s\n", d_VCX);
                     75:        printf("->  n: %s\n", d_CPL);
                     76:        printf("    ...\n");
                     77:        printf("    1: %s\n\n", d_CPL);
                     78: 
                     79:        printf("    1: %s\n", d_MIN);
                     80:        printf("-> nm: %s\n", d_INT);
                     81:        printf("    ...\n");
                     82:        printf("    1: %s\n\n", d_INT);
                     83: 
                     84:        printf("    1: %s\n", d_MRL);
                     85:        printf("-> nm: %s\n", d_REL);
                     86:        printf("    ...\n");
                     87:        printf("    1: %s\n\n", d_REL);
                     88: 
                     89:        printf("    1: %s\n", d_MCX);
                     90:        printf("-> nm: %s\n", d_CPL);
                     91:        printf("    ...\n");
                     92:        printf("    1: %s\n", d_CPL);
                     93: 
                     94:        return;
                     95:    }
                     96:    else if ((*s_etat_processus).test_instruction == 'Y')
                     97:    {
                     98:        (*s_etat_processus).nombre_arguments = -1;
                     99:        return;
                    100:    }
                    101: 
                    102:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    103:    {
                    104:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    105:        {
                    106:            return;
                    107:        }
                    108:    }
                    109: 
                    110:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    111:            &s_objet_source) == d_erreur)
                    112:    {
                    113:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    114:        return;
                    115:    }
                    116: 
                    117: /*
                    118: --------------------------------------------------------------------------------
                    119:   Cas des vecteurs
                    120: --------------------------------------------------------------------------------
                    121: */
                    122: 
                    123:    if ((*s_objet_source).type == VIN)
                    124:    {
                    125:        /*
                    126:         * Traitement d'un vecteur d'entiers
                    127:         */
                    128: 
                    129:        for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
                    130:                i++)
                    131:        {
                    132:            if ((s_objet_elementaire = allocation(s_etat_processus, INT))
                    133:                    == NULL)
                    134:            {
                    135:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    136:                return;
                    137:            }
                    138: 
                    139:            (*((integer8 *) (*s_objet_elementaire).objet)) =
                    140:                    ((integer8 *) (*((struct_vecteur *)
                    141:                    (*s_objet_source).objet)).tableau)[i];
                    142: 
                    143:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    144:                    s_objet_elementaire) == d_erreur)
                    145:            {
                    146:                return;
                    147:            }
                    148:        }
                    149: 
                    150:        if ((s_objet_elementaire = allocation(s_etat_processus, LST))
                    151:                == NULL)
                    152:        {
                    153:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    154:            return;
                    155:        }
                    156: 
                    157:        if (((*s_objet_elementaire).objet =
                    158:                allocation_maillon(s_etat_processus)) == NULL)
                    159:        {
                    160:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    161:            return;
                    162:        }
                    163: 
                    164:        l_element_courant = (struct_liste_chainee *)
                    165:                (*s_objet_elementaire).objet;
                    166: 
                    167:        (*l_element_courant).suivant = NULL;
                    168: 
                    169:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    170:                == NULL)
                    171:        {
                    172:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    173:            return;
                    174:        }
                    175: 
                    176:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    177:                (*((struct_vecteur *) (*s_objet_source).objet)).taille;
                    178:        
                    179:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    180:                s_objet_elementaire) == d_erreur)
                    181:        {
                    182:            return;
                    183:        }
                    184:    }
                    185:    else if ((*s_objet_source).type == VRL)
                    186:    {
                    187:        /*
                    188:         * Traitement d'un vecteur de réels
                    189:         */
                    190: 
                    191:        for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
                    192:                i++)
                    193:        {
                    194:            if ((s_objet_elementaire = allocation(s_etat_processus, REL))
                    195:                    == NULL)
                    196:            {
                    197:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    198:                return;
                    199:            }
                    200: 
                    201:            (*((real8 *) (*s_objet_elementaire).objet)) =
                    202:                    ((real8 *) (*((struct_vecteur *)
                    203:                    (*s_objet_source).objet)).tableau)[i];
                    204: 
                    205:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    206:                    s_objet_elementaire) == d_erreur)
                    207:            {
                    208:                return;
                    209:            }
                    210:        }
                    211: 
                    212:        if ((s_objet_elementaire = allocation(s_etat_processus, LST))
                    213:                == NULL)
                    214:        {
                    215:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    216:            return;
                    217:        }
                    218: 
                    219:        if (((*s_objet_elementaire).objet =
                    220:                allocation_maillon(s_etat_processus)) == NULL)
                    221:        {
                    222:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    223:            return;
                    224:        }
                    225: 
                    226:        l_element_courant = (struct_liste_chainee *)
                    227:                (*s_objet_elementaire).objet;
                    228: 
                    229:        (*l_element_courant).suivant = NULL;
                    230: 
                    231:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    232:                == NULL)
                    233:        {
                    234:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    235:            return;
                    236:        }
                    237: 
                    238:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    239:                (*((struct_vecteur *) (*s_objet_source).objet)).taille;
                    240:        
                    241:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    242:                s_objet_elementaire) == d_erreur)
                    243:        {
                    244:            return;
                    245:        }
                    246:    }
                    247:    else if ((*s_objet_source).type == VCX)
                    248:    {
                    249:        /*
                    250:         * Traitement d'un vecteur de complexes
                    251:         */
                    252: 
                    253:        for(i = 0; i < (*((struct_vecteur *) (*s_objet_source).objet)).taille;
                    254:                i++)
                    255:        {
                    256:            if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
                    257:                    == NULL)
                    258:            {
                    259:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    260:                return;
                    261:            }
                    262: 
                    263:            (*((struct_complexe16 *) (*s_objet_elementaire).objet))
                    264:                    .partie_reelle = ((struct_complexe16 *)
                    265:                    (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
                    266:                    .partie_reelle;
                    267:            (*((struct_complexe16 *) (*s_objet_elementaire).objet))
                    268:                    .partie_imaginaire = ((struct_complexe16 *)
                    269:                    (*((struct_vecteur *) (*s_objet_source).objet)).tableau)[i]
                    270:                    .partie_imaginaire;
                    271: 
                    272:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    273:                    s_objet_elementaire) == d_erreur)
                    274:            {
                    275:                return;
                    276:            }
                    277:        }
                    278: 
                    279:        if ((s_objet_elementaire = allocation(s_etat_processus, LST))
                    280:                == NULL)
                    281:        {
                    282:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    283:            return;
                    284:        }
                    285: 
                    286:        if (((*s_objet_elementaire).objet =
                    287:                allocation_maillon(s_etat_processus)) == NULL)
                    288:        {
                    289:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    290:            return;
                    291:        }
                    292: 
                    293:        l_element_courant = (struct_liste_chainee *)
                    294:                (*s_objet_elementaire).objet;
                    295: 
                    296:        (*l_element_courant).suivant = NULL;
                    297: 
                    298:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    299:                == NULL)
                    300:        {
                    301:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    302:            return;
                    303:        }
                    304: 
                    305:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    306:                (*((struct_vecteur *) (*s_objet_source).objet)).taille;
                    307:        
                    308:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    309:                s_objet_elementaire) == d_erreur)
                    310:        {
                    311:            return;
                    312:        }
                    313:    }
                    314: 
                    315: /*
                    316: --------------------------------------------------------------------------------
                    317:   Cas des matrices
                    318: --------------------------------------------------------------------------------
                    319: */
                    320: 
                    321:    else if ((*s_objet_source).type == MIN)
                    322:    {
                    323:        /*
                    324:         * Traitement d'une matrice d'entiers
                    325:         */
                    326: 
                    327:        for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
                    328:                .nombre_lignes; i++)
                    329:        {
                    330:            for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
                    331:                    .nombre_colonnes; j++)
                    332:            {
                    333:                if ((s_objet_elementaire = allocation(s_etat_processus, INT))
                    334:                        == NULL)
                    335:                {
                    336:                    (*s_etat_processus).erreur_systeme =
                    337:                            d_es_allocation_memoire;
                    338:                    return;
                    339:                }
                    340: 
                    341:                (*((integer8 *) (*s_objet_elementaire).objet)) =
                    342:                        ((integer8 **) (*((struct_matrice *)
                    343:                        (*s_objet_source).objet)).tableau)[i][j];
                    344: 
                    345:                if (empilement(s_etat_processus, &((*s_etat_processus)
                    346:                        .l_base_pile), s_objet_elementaire) == d_erreur)
                    347:                {
                    348:                    return;
                    349:                }
                    350:            }
                    351:        }
                    352: 
                    353:        if ((s_objet_elementaire = allocation(s_etat_processus, LST))
                    354:                == NULL)
                    355:        {
                    356:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    357:            return;
                    358:        }
                    359: 
                    360:        if (((*s_objet_elementaire).objet =
                    361:                allocation_maillon(s_etat_processus)) == NULL)
                    362:        {
                    363:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    364:            return;
                    365:        }
                    366: 
                    367:        l_element_courant = (struct_liste_chainee *)
                    368:                (*s_objet_elementaire).objet;
                    369: 
                    370:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    371:                == NULL)
                    372:        {
                    373:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    374:            return;
                    375:        }
                    376: 
                    377:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    378:                (*((struct_matrice *) (*s_objet_source).objet))
                    379:                .nombre_lignes;
                    380:        
                    381:        if (((*l_element_courant).suivant =
                    382:                allocation_maillon(s_etat_processus)) == NULL)
                    383:        {
                    384:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    385:            return;
                    386:        }
                    387: 
                    388:        l_element_courant = (*l_element_courant).suivant;
                    389:        (*l_element_courant).suivant = NULL;
                    390: 
                    391:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    392:                == NULL)
                    393:        {
                    394:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    395:            return;
                    396:        }
                    397: 
                    398:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    399:                (*((struct_matrice *) (*s_objet_source).objet))
                    400:                .nombre_colonnes;
                    401: 
                    402:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    403:                s_objet_elementaire) == d_erreur)
                    404:        {
                    405:            return;
                    406:        }
                    407:    }
                    408:    else if ((*s_objet_source).type == MRL)
                    409:    {
                    410:        /*
                    411:         * Traitement d'une matrice de réels
                    412:         */
                    413: 
                    414:        for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
                    415:                .nombre_lignes; i++)
                    416:        {
                    417:            for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
                    418:                    .nombre_colonnes; j++)
                    419:            {
                    420:                if ((s_objet_elementaire = allocation(s_etat_processus, REL))
                    421:                        == NULL)
                    422:                {
                    423:                    (*s_etat_processus).erreur_systeme =
                    424:                            d_es_allocation_memoire;
                    425:                    return;
                    426:                }
                    427: 
                    428:                (*((real8 *) (*s_objet_elementaire).objet)) =
                    429:                        ((real8 **) (*((struct_matrice *)
                    430:                        (*s_objet_source).objet)).tableau)[i][j];
                    431: 
                    432:                if (empilement(s_etat_processus, &((*s_etat_processus)
                    433:                        .l_base_pile), s_objet_elementaire) == d_erreur)
                    434:                {
                    435:                    return;
                    436:                }
                    437:            }
                    438:        }
                    439: 
                    440:        if ((s_objet_elementaire = allocation(s_etat_processus, LST))
                    441:                == NULL)
                    442:        {
                    443:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    444:            return;
                    445:        }
                    446: 
                    447:        if (((*s_objet_elementaire).objet =
                    448:                allocation_maillon(s_etat_processus)) == NULL)
                    449:        {
                    450:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    451:            return;
                    452:        }
                    453: 
                    454:        l_element_courant = (struct_liste_chainee *)
                    455:                (*s_objet_elementaire).objet;
                    456: 
                    457:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    458:                == NULL)
                    459:        {
                    460:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    461:            return;
                    462:        }
                    463: 
                    464:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    465:                (*((struct_matrice *) (*s_objet_source).objet))
                    466:                .nombre_lignes;
                    467:        
                    468:        if (((*l_element_courant).suivant =
                    469:                allocation_maillon(s_etat_processus)) == NULL)
                    470:        {
                    471:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    472:            return;
                    473:        }
                    474: 
                    475:        l_element_courant = (*l_element_courant).suivant;
                    476:        (*l_element_courant).suivant = NULL;
                    477: 
                    478:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    479:                == NULL)
                    480:        {
                    481:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    482:            return;
                    483:        }
                    484: 
                    485:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    486:                (*((struct_matrice *) (*s_objet_source).objet))
                    487:                .nombre_colonnes;
                    488: 
                    489:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    490:                s_objet_elementaire) == d_erreur)
                    491:        {
                    492:            return;
                    493:        }
                    494:    }
                    495:    else if ((*s_objet_source).type == MCX)
                    496:    {
                    497:        /*
                    498:         * Traitement d'une matrice de complexes
                    499:         */
                    500: 
                    501:        for(i = 0; i < (*((struct_matrice *) (*s_objet_source).objet))
                    502:                .nombre_lignes; i++)
                    503:        {
                    504:            for(j = 0; j < (*((struct_matrice *) (*s_objet_source).objet))
                    505:                    .nombre_colonnes; j++)
                    506:            {
                    507:                if ((s_objet_elementaire = allocation(s_etat_processus, CPL))
                    508:                        == NULL)
                    509:                {
                    510:                    (*s_etat_processus).erreur_systeme =
                    511:                            d_es_allocation_memoire;
                    512:                    return;
                    513:                }
                    514: 
                    515:                (*((struct_complexe16 *) (*s_objet_elementaire).objet))
                    516:                        .partie_reelle = ((struct_complexe16 **)
                    517:                        (*((struct_matrice *) (*s_objet_source).objet))
                    518:                        .tableau)[i][j].partie_reelle;
                    519:                (*((struct_complexe16 *) (*s_objet_elementaire).objet))
                    520:                        .partie_imaginaire = ((struct_complexe16 **)
                    521:                        (*((struct_matrice *) (*s_objet_source).objet))
                    522:                        .tableau)[i][j].partie_imaginaire;
                    523: 
                    524:                if (empilement(s_etat_processus, &((*s_etat_processus)
                    525:                        .l_base_pile), s_objet_elementaire) == d_erreur)
                    526:                {
                    527:                    return;
                    528:                }
                    529:            }
                    530:        }
                    531: 
                    532:        if ((s_objet_elementaire = allocation(s_etat_processus, LST))
                    533:                == NULL)
                    534:        {
                    535:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    536:            return;
                    537:        }
                    538: 
                    539:        if (((*s_objet_elementaire).objet =
                    540:                allocation_maillon(s_etat_processus)) == NULL)
                    541:        {
                    542:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    543:            return;
                    544:        }
                    545: 
                    546:        l_element_courant = (struct_liste_chainee *)
                    547:                (*s_objet_elementaire).objet;
                    548: 
                    549:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    550:                == NULL)
                    551:        {
                    552:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    553:            return;
                    554:        }
                    555: 
                    556:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    557:                (*((struct_matrice *) (*s_objet_source).objet))
                    558:                .nombre_lignes;
                    559:        
                    560:        if (((*l_element_courant).suivant =
                    561:                allocation_maillon(s_etat_processus)) == NULL)
                    562:        {
                    563:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    564:            return;
                    565:        }
                    566: 
                    567:        l_element_courant = (*l_element_courant).suivant;
                    568:        (*l_element_courant).suivant = NULL;
                    569: 
                    570:        if (((*l_element_courant).donnee = allocation(s_etat_processus, INT))
                    571:                == NULL)
                    572:        {
                    573:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    574:            return;
                    575:        }
                    576: 
                    577:        (*((integer8 *) (*(*l_element_courant).donnee).objet)) =
                    578:                (*((struct_matrice *) (*s_objet_source).objet))
                    579:                .nombre_colonnes;
                    580: 
                    581:        if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    582:                s_objet_elementaire) == d_erreur)
                    583:        {
                    584:            return;
                    585:        }
                    586:    }
                    587: 
                    588: /*
                    589: --------------------------------------------------------------------------------
                    590:   Réalisation impossible de la fonction ARRAY->
                    591: --------------------------------------------------------------------------------
                    592: */
                    593: 
                    594:    else
                    595:    {
                    596:        liberation(s_etat_processus, s_objet_source);
                    597: 
                    598:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    599:        return;
                    600:    }
                    601: 
                    602:    liberation(s_etat_processus, s_objet_source);
                    603: 
                    604:    return;
                    605: }
                    606: 
                    607: 
                    608: /*
                    609: ================================================================================
                    610:   Fonction 'alog'
                    611: ================================================================================
                    612:   Entrées : pointeur sur une struct_processus
                    613: --------------------------------------------------------------------------------
                    614:   Sorties :
                    615: --------------------------------------------------------------------------------
                    616:   Effets de bord : néant
                    617: ================================================================================
                    618: */
                    619: 
                    620: void
                    621: instruction_alog(struct_processus *s_etat_processus)
                    622: {
                    623:    integer8                        base;
                    624:    integer8                        tampon;
                    625: 
                    626:    struct_liste_chainee            *l_element_courant;
                    627:    struct_liste_chainee            *l_element_precedent;
                    628: 
                    629:    struct_objet                    *s_copie_argument;
                    630:    struct_objet                    *s_objet_argument;
                    631:    struct_objet                    *s_objet_resultat;
                    632: 
                    633:    (*s_etat_processus).erreur_execution = d_ex;
                    634: 
                    635:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    636:    {
                    637:        printf("\n  ALOG ");
                    638: 
                    639:        if ((*s_etat_processus).langue == 'F')
                    640:        {
                    641:            printf("(antilogarithme base 10)\n\n");
                    642:        }
                    643:        else
                    644:        {
                    645:            printf("(10-based antilogarithm)\n\n");
                    646:        }
                    647: 
                    648:        printf("    1: %s\n", d_INT);
                    649:        printf("->  1: %s, %s\n\n", d_INT, d_REL);
                    650: 
                    651:        printf("    1: %s\n", d_REL);
                    652:        printf("->  1: %s\n", d_REL);
                    653: 
                    654:        printf("    1: %s\n", d_CPL);
                    655:        printf("->  1: %s\n", d_CPL);
                    656: 
                    657:        printf("    1: %s, %s\n", d_NOM, d_ALG);
                    658:        printf("->  1: %s\n\n", d_ALG);
                    659: 
                    660:        printf("    1: %s\n", d_RPN);
                    661:        printf("->  1: %s\n", d_RPN);
                    662: 
                    663:        return;
                    664:    }
                    665:    else if ((*s_etat_processus).test_instruction == 'Y')
                    666:    {
                    667:        (*s_etat_processus).nombre_arguments = 1;
                    668:        return;
                    669:    }
                    670: 
                    671:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    672:    {
                    673:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    674:        {
                    675:            return;
                    676:        }
                    677:    }
                    678: 
                    679:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    680:            &s_objet_argument) == d_erreur)
                    681:    {
                    682:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    683:        return;
                    684:    }
                    685: 
                    686: /*
                    687: --------------------------------------------------------------------------------
                    688:   Alog d'un entier
                    689: --------------------------------------------------------------------------------
                    690: */
                    691: 
                    692:    if ((*s_objet_argument).type == INT)
                    693:    {
                    694:        base = 10;
                    695: 
                    696:        if (depassement_puissance(&base, (integer8 *) (*s_objet_argument).objet,
                    697:                &tampon) == d_absence_erreur)
                    698:        {
                    699:            if ((s_objet_resultat = allocation(s_etat_processus, INT))
                    700:                    == NULL)
                    701:            {
                    702:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    703:                return;
                    704:            }
                    705: 
                    706:            (*((integer8 *) (*s_objet_resultat).objet)) = tampon;
                    707:        }
                    708:        else
                    709:        {
                    710:            if ((s_objet_resultat = allocation(s_etat_processus, REL))
                    711:                    == NULL)
                    712:            {
                    713:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    714:                return;
                    715:            }
                    716: 
                    717:            (*((real8 *) (*s_objet_resultat).objet)) =
                    718:                    pow((real8) 10, (real8) (*((integer8 *)
                    719:                    (*s_objet_argument).objet)));
                    720:        }
                    721:    }
                    722: 
                    723: /*
                    724: --------------------------------------------------------------------------------
                    725:   Alog d'un réel
                    726: --------------------------------------------------------------------------------
                    727: */
                    728: 
                    729:    else if ((*s_objet_argument).type == REL)
                    730:    {
                    731:        if ((s_objet_resultat = allocation(s_etat_processus, REL))
                    732:                == NULL)
                    733:        {
                    734:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    735:            return;
                    736:        }
                    737: 
                    738:        (*((real8 *) (*s_objet_resultat).objet)) =
                    739:                pow((real8) 10, ((*((real8 *) (*s_objet_argument).objet))));
                    740:    }
                    741: 
                    742: /*
                    743: --------------------------------------------------------------------------------
                    744:   Alog d'un complexe
                    745: --------------------------------------------------------------------------------
                    746: */
                    747: 
                    748:    else if ((*s_objet_argument).type == CPL)
                    749:    {
                    750:        if ((s_objet_resultat = allocation(s_etat_processus, CPL))
                    751:                == NULL)
                    752:        {
                    753:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    754:            return;
                    755:        }
                    756: 
                    757:        f77alogc_(&((*((struct_complexe16 *) (*s_objet_argument).objet))),
                    758:                (struct_complexe16 *) (*s_objet_resultat).objet);
                    759:    }
                    760: 
                    761: /*
                    762: --------------------------------------------------------------------------------
                    763:   Alog d'un nom
                    764: --------------------------------------------------------------------------------
                    765: */
                    766: 
                    767:    else if ((*s_objet_argument).type == NOM)
                    768:    {
                    769:        if ((s_objet_resultat = allocation(s_etat_processus, ALG))
                    770:                == NULL)
                    771:        {
                    772:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    773:            return;
                    774:        }
                    775: 
                    776:        if (((*s_objet_resultat).objet =
                    777:                allocation_maillon(s_etat_processus)) == NULL)
                    778:        {
                    779:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    780:            return;
                    781:        }
                    782: 
                    783:        l_element_courant = (*s_objet_resultat).objet;
                    784: 
                    785:        if (((*l_element_courant).donnee =
                    786:                allocation(s_etat_processus, FCT)) == NULL)
                    787:        {
                    788:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    789:            return;
                    790:        }
                    791: 
                    792:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    793:                .nombre_arguments = 0;
                    794:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    795:                .fonction = instruction_alog;
                    796: 
                    797:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    798:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                    799:        {
                    800:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    801:            return;
                    802:        }
                    803: 
                    804:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    805:                .nom_fonction, "<<");
                    806: 
                    807:        if (((*l_element_courant).suivant =
                    808:                allocation_maillon(s_etat_processus)) == NULL)
                    809:        {
                    810:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    811:            return;
                    812:        }
                    813: 
                    814:        l_element_courant = (*l_element_courant).suivant;
                    815:        (*l_element_courant).donnee = s_objet_argument;
                    816: 
                    817:        if (((*l_element_courant).suivant =
                    818:                allocation_maillon(s_etat_processus)) == NULL)
                    819:        {
                    820:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    821:            return;
                    822:        }
                    823: 
                    824:        l_element_courant = (*l_element_courant).suivant;
                    825: 
                    826:        if (((*l_element_courant).donnee =
                    827:                allocation(s_etat_processus, FCT)) == NULL)
                    828:        {
                    829:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    830:            return;
                    831:        }
                    832: 
                    833:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    834:                .nombre_arguments = 1;
                    835:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    836:                .fonction = instruction_alog;
                    837: 
                    838:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    839:                .nom_fonction = malloc(5 * sizeof(unsigned char))) == NULL)
                    840:        {
                    841:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    842:            return;
                    843:        }
                    844:            
                    845:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    846:                .nom_fonction, "ALOG");
                    847: 
                    848:        if (((*l_element_courant).suivant =
                    849:                allocation_maillon(s_etat_processus)) == NULL)
                    850:        {
                    851:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    852:            return;
                    853:        }
                    854: 
                    855:        l_element_courant = (*l_element_courant).suivant;
                    856: 
                    857:        if (((*l_element_courant).donnee =
                    858:                allocation(s_etat_processus, FCT)) == NULL)
                    859:        {
                    860:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    861:            return;
                    862:        }
                    863: 
                    864:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    865:                .nombre_arguments = 0;
                    866:        (*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    867:                .fonction = instruction_vers_niveau_inferieur;
                    868: 
                    869:        if (((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    870:                .nom_fonction = malloc(3 * sizeof(unsigned char))) == NULL)
                    871:        {
                    872:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    873:            return;
                    874:        }
                    875: 
                    876:        strcpy((*((struct_fonction *) (*(*l_element_courant).donnee).objet))
                    877:                .nom_fonction, ">>");
                    878: 
                    879:        (*l_element_courant).suivant = NULL;
                    880:        s_objet_argument = NULL;
                    881:    }
                    882: 
                    883: /*
                    884: --------------------------------------------------------------------------------
                    885:   Alog d'une expression
                    886: --------------------------------------------------------------------------------
                    887: */
                    888: 
                    889:    else if (((*s_objet_argument).type == ALG) ||
                    890:            ((*s_objet_argument).type == RPN))
                    891:    {
                    892:        if ((s_copie_argument = copie_objet(s_etat_processus,
                    893:                s_objet_argument, 'N')) == NULL)
                    894:        {
                    895:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    896:            return;
                    897:        }
                    898: 
                    899:        l_element_courant = (struct_liste_chainee *)
                    900:                (*s_copie_argument).objet;
                    901:        l_element_precedent = l_element_courant;
                    902: 
                    903:        while((*l_element_courant).suivant != NULL)
                    904:        {
                    905:            l_element_precedent = l_element_courant;
                    906:            l_element_courant = (*l_element_courant).suivant;
                    907:        }
                    908: 
                    909:        if (((*l_element_precedent).suivant =
                    910:                allocation_maillon(s_etat_processus)) == NULL)
                    911:        {
                    912:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    913:            return;
                    914:        }
                    915: 
                    916:        if (((*(*l_element_precedent).suivant).donnee =
                    917:                allocation(s_etat_processus, FCT)) == NULL)
                    918:        {
                    919:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    920:            return;
                    921:        }
                    922: 
                    923:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                    924:                .donnee).objet)).nombre_arguments = 1;
                    925:        (*((struct_fonction *) (*(*(*l_element_precedent).suivant)
                    926:                .donnee).objet)).fonction = instruction_alog;
                    927: 
                    928:        if (((*((struct_fonction *) (*(*(*l_element_precedent)
                    929:                .suivant).donnee).objet)).nom_fonction =
                    930:                malloc(5 * sizeof(unsigned char))) == NULL)
                    931:        {
                    932:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    933:            return;
                    934:        }
                    935: 
                    936:        strcpy((*((struct_fonction *) (*(*(*l_element_precedent)
                    937:                .suivant).donnee).objet)).nom_fonction, "ALOG");
                    938: 
                    939:        (*(*l_element_precedent).suivant).suivant = l_element_courant;
                    940: 
                    941:        s_objet_resultat = s_copie_argument;
                    942:    }
                    943: 
                    944: /*
                    945: --------------------------------------------------------------------------------
                    946:   Fonction alog impossible à réaliser
                    947: --------------------------------------------------------------------------------
                    948: */
                    949: 
                    950:    else
                    951:    {
                    952:        liberation(s_etat_processus, s_objet_argument);
                    953: 
                    954:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    955:        return;
                    956:    }
                    957: 
                    958:    liberation(s_etat_processus, s_objet_argument);
                    959: 
                    960:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    961:            s_objet_resultat) == d_erreur)
                    962:    {
                    963:        return;
                    964:    }
                    965: 
                    966:    return;
                    967: }
                    968: 
                    969: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>