Annotation of rpl/src/instructions_f4.c, revision 1.39

1.1       bertrand    1: /*
                      2: ================================================================================
1.39    ! bertrand    3:   RPL/2 (R) version 4.1.12
1.30      bertrand    4:   Copyright (C) 1989-2012 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 '->table'
                     29: ================================================================================
                     30:   Entrées : structure processus
                     31: --------------------------------------------------------------------------------
                     32:   Sorties :
                     33: --------------------------------------------------------------------------------
                     34:   Effets de bord : néant
                     35: ================================================================================
                     36: */
                     37: 
                     38: void
                     39: instruction_fleche_table(struct_processus *s_etat_processus)
                     40: {
                     41:    struct_objet                    *s_objet;
                     42: 
                     43:    signed long                     i;
                     44:    signed long                     nombre_elements;
                     45: 
                     46:     (*s_etat_processus).erreur_execution = d_ex;
                     47: 
                     48:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     49:    {
                     50:        printf("\n  ->TABLE ");
                     51: 
                     52:        if ((*s_etat_processus).langue == 'F')
                     53:        {
                     54:            printf("(création d'une table)\n\n");
                     55:        }
                     56:        else
                     57:        {
                     58:            printf("(create table)\n\n");
                     59:        }
                     60: 
                     61:        printf("    n: %s, %s, %s, %s, %s, %s,\n"
                     62:                "       %s, %s, %s, %s, %s,\n"
                     63:                "       %s, %s, %s, %s, %s,\n"
                     64:                "       %s, %s\n",
                     65:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                     66:                d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
                     67:        printf("    ...\n");
                     68:        printf("    2: %s, %s, %s, %s, %s, %s,\n"
                     69:                "       %s, %s, %s, %s, %s,\n"
                     70:                "       %s, %s, %s, %s, %s,\n"
                     71:                "       %s, %s\n",
                     72:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                     73:                d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN, d_FCH, d_SLB);
                     74:        printf("    1: %s\n", d_INT);
                     75:        printf("->  1: %s\n", d_TAB);
                     76: 
                     77:        return;
                     78:    }
                     79:    else if ((*s_etat_processus).test_instruction == 'Y')
                     80:    {
                     81:        (*s_etat_processus).nombre_arguments = -1;
                     82:        return;
                     83:    }
                     84: 
                     85:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                     86:    {
                     87:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                     88:        {
                     89:            return;
                     90:        }
                     91:    }
                     92: 
                     93:    if ((*s_etat_processus).hauteur_pile_operationnelle == 0)
                     94:    {
                     95:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                     96:        return;
                     97:    }
                     98: 
                     99:    if ((*(*(*s_etat_processus).l_base_pile).donnee).type != INT)
                    100:    {
                    101:        (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    102:        return;
                    103:    }
                    104: 
                    105:    nombre_elements = (*((integer8 *) (*(*(*s_etat_processus).l_base_pile)
                    106:            .donnee).objet));
                    107: 
                    108:    if (nombre_elements < 0)
                    109:    {
                    110: 
                    111: /*
                    112: -- Opération absurde autorisée sur le calculateur HP-28S -----------------------
                    113: */
                    114: 
                    115:        (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
                    116:        return;
                    117:    }
                    118: 
                    119:    if ((unsigned long) nombre_elements >=
                    120:            (*s_etat_processus).hauteur_pile_operationnelle)
                    121:    {
                    122:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    123:        return;
                    124:    }
                    125: 
                    126:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    127:    {
                    128:        if (empilement_pile_last(s_etat_processus, nombre_elements + 1)
                    129:                == d_erreur)
                    130:        {
                    131:            return;
                    132:        }
                    133:    }
                    134: 
                    135:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    136:            &s_objet) == d_erreur)
                    137:    {
                    138:        return;
                    139:    }
                    140: 
                    141:    liberation(s_etat_processus, s_objet);
                    142: 
                    143:    if ((s_objet = allocation(s_etat_processus, TBL)) == NULL)
                    144:    {
                    145:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    146:        return;
                    147:    }
                    148: 
                    149:    (*((struct_tableau *) (*s_objet).objet)).nombre_elements =
                    150:            nombre_elements;
                    151: 
                    152:    if (((*((struct_tableau *) (*s_objet).objet)).elements = malloc(
                    153:            nombre_elements * sizeof(struct_objet *))) == NULL)
                    154:    {
                    155:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    156:        return;
                    157:    }
                    158: 
                    159:    for(i = 0; i < nombre_elements; i++)
                    160:    {
                    161:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    162:                &((*((struct_tableau *) (*s_objet).objet)).elements
                    163:                [nombre_elements - (i + 1)])) == d_erreur)
                    164:        {
                    165:            return;
                    166:        }
                    167:    }
                    168: 
                    169:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    170:            s_objet) == d_erreur)
                    171:    {
                    172:        return;
                    173:    }
                    174: 
                    175:     return;
                    176: }
                    177: 
                    178: 
                    179: /*
                    180: ================================================================================
                    181:   Fonction '->diag'
                    182: ================================================================================
                    183:   Entrées : pointeur sur une structure struct_processus
                    184: --------------------------------------------------------------------------------
                    185:   Sorties :
                    186: --------------------------------------------------------------------------------
                    187:   Effets de bord : néant
                    188: ================================================================================
                    189: */
                    190: 
                    191: void
                    192: instruction_fleche_diag(struct_processus *s_etat_processus)
                    193: {
                    194:    struct_objet                *s_objet_argument;
                    195:    struct_objet                *s_objet_resultat;
                    196: 
                    197:    unsigned long               i;
                    198:    unsigned long               j;
                    199: 
                    200:    (*s_etat_processus).erreur_execution = d_ex;
                    201: 
                    202:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    203:    {
                    204:        printf("\n  ->DIAG ");
                    205: 
                    206:        if ((*s_etat_processus).langue == 'F')
                    207:        {
                    208:            printf("(conversion d'un vecteur en matrice diaginale)\n\n");
                    209:        }
                    210:        else
                    211:        {
                    212:            printf("(vector to diagonal matrix conversion)\n\n");
                    213:        }
                    214: 
                    215:        printf("->  1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
                    216:        printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
                    217: 
                    218:        return;
                    219:    }
                    220:    else if ((*s_etat_processus).test_instruction == 'Y')
                    221:    {
                    222:        (*s_etat_processus).nombre_arguments = -1;
                    223:        return;
                    224:    }
                    225: 
                    226:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    227:    {
                    228:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    229:        {
                    230:            return;
                    231:        }
                    232:    }
                    233: 
                    234:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    235:            &s_objet_argument) == d_erreur)
                    236:    {
                    237:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    238:        return;
                    239:    }
                    240: 
                    241:    /*
                    242:     * Conversion d'un vecteur
                    243:     */
                    244: 
                    245:    if ((*s_objet_argument).type == VIN)
                    246:    {
                    247:        if ((s_objet_resultat = allocation(s_etat_processus, MIN)) == NULL)
                    248:        {
                    249:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    250:            return;
                    251:        }
                    252: 
                    253:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
                    254:                (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
                    255:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
                    256:                (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
                    257: 
                    258:        if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
                    259:                malloc((*((struct_matrice *) (*s_objet_resultat).objet))
                    260:                .nombre_lignes * sizeof(integer8 *))) == NULL)
                    261:        {
                    262:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    263:            return;
                    264:        }
                    265: 
                    266:        for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
                    267:                .nombre_lignes; i++)
                    268:        {
                    269:            if ((((integer8 **) (*((struct_matrice *)
                    270:                    (*s_objet_resultat).objet)).tableau)[i] =
                    271:                    malloc((*((struct_matrice *)
                    272:                    (*s_objet_resultat).objet)).nombre_colonnes *
                    273:                    sizeof(integer8))) == NULL)
                    274:            {
                    275:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    276:                return;
                    277:            }
                    278: 
                    279:            for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
                    280:                    .nombre_colonnes; j++)
                    281:            {
                    282:                if (i != j)
                    283:                {
                    284:                    ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
                    285:                            .objet)).tableau)[i][j] = 0;
                    286:                }
                    287:                else
                    288:                {
                    289:                    ((integer8 **) (*((struct_matrice *) (*s_objet_resultat)
                    290:                            .objet)).tableau)[i][j] = ((integer8 *)
                    291:                            (*((struct_vecteur *) (*s_objet_argument)
                    292:                            .objet)).tableau)[i];      
                    293:                }
                    294:            }
                    295:        }
                    296:    }
                    297:    else if ((*s_objet_argument).type == VRL)
                    298:    {
                    299:        if ((s_objet_resultat = allocation(s_etat_processus, MRL)) == NULL)
                    300:        {
                    301:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    302:            return;
                    303:        }
                    304: 
                    305:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
                    306:                (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
                    307:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
                    308:                (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
                    309: 
                    310:        if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
                    311:                malloc((*((struct_matrice *) (*s_objet_resultat).objet))
                    312:                .nombre_lignes * sizeof(real8 *))) == NULL)
                    313:        {
                    314:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    315:            return;
                    316:        }
                    317: 
                    318:        for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
                    319:                .nombre_lignes; i++)
                    320:        {
                    321:            if ((((real8 **) (*((struct_matrice *)
                    322:                    (*s_objet_resultat).objet)).tableau)[i] =
                    323:                    malloc((*((struct_matrice *)
                    324:                    (*s_objet_resultat).objet)).nombre_colonnes *
                    325:                    sizeof(real8))) == NULL)
                    326:            {
                    327:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    328:                return;
                    329:            }
                    330: 
                    331:            for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
                    332:                    .nombre_colonnes; j++)
                    333:            {
                    334:                if (i != j)
                    335:                {
                    336:                    ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                    337:                            .objet)).tableau)[i][j] = 0;
                    338:                }
                    339:                else
                    340:                {
                    341:                    ((real8 **) (*((struct_matrice *) (*s_objet_resultat)
                    342:                            .objet)).tableau)[i][j] = ((real8 *)
                    343:                            (*((struct_vecteur *) (*s_objet_argument)
                    344:                            .objet)).tableau)[i];      
                    345:                }
                    346:            }
                    347:        }
                    348:    }
                    349:    else if ((*s_objet_argument).type == VCX)
                    350:    {
                    351:        if ((s_objet_resultat = allocation(s_etat_processus, MCX)) == NULL)
                    352:        {
                    353:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    354:            return;
                    355:        }
                    356: 
                    357:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_lignes =
                    358:                (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
                    359:        (*((struct_matrice *) (*s_objet_resultat).objet)).nombre_colonnes =
                    360:                (*((struct_vecteur *) (*s_objet_argument).objet)).taille;
                    361: 
                    362:        if (((*((struct_matrice *) (*s_objet_resultat).objet)).tableau =
                    363:                malloc((*((struct_matrice *) (*s_objet_resultat).objet))
                    364:                .nombre_lignes * sizeof(complex16 *))) == NULL)
                    365:        {
                    366:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    367:            return;
                    368:        }
                    369: 
                    370:        for(i = 0; i < (*((struct_matrice *) (*s_objet_resultat).objet))
                    371:                .nombre_lignes; i++)
                    372:        {
                    373:            if ((((complex16 **) (*((struct_matrice *)
                    374:                    (*s_objet_resultat).objet)).tableau)[i] =
                    375:                    malloc((*((struct_matrice *)
                    376:                    (*s_objet_resultat).objet)).nombre_colonnes *
                    377:                    sizeof(complex16))) == NULL)
                    378:            {
                    379:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    380:                return;
                    381:            }
                    382: 
                    383:            for(j = 0; j < (*((struct_matrice *) (*s_objet_resultat).objet))
                    384:                    .nombre_colonnes; j++)
                    385:            {
                    386:                if (i != j)
                    387:                {
                    388:                    ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
                    389:                            .objet)).tableau)[i][j].partie_reelle = 0;
                    390:                    ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
                    391:                            .objet)).tableau)[i][j].partie_imaginaire = 0;
                    392:                }
                    393:                else
                    394:                {
                    395:                    ((complex16 **) (*((struct_matrice *) (*s_objet_resultat)
                    396:                            .objet)).tableau)[i][j] = ((complex16 *)
                    397:                            (*((struct_vecteur *) (*s_objet_argument)
                    398:                            .objet)).tableau)[i];      
                    399:                }
                    400:            }
                    401:        }
                    402:    }
                    403: 
                    404:    /*
                    405:     * Conversion impossible impossible
                    406:     */
                    407: 
                    408:    else
                    409:    {
                    410:        liberation(s_etat_processus, s_objet_argument);
                    411: 
                    412:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    413:        return;
                    414:    }
                    415: 
                    416:    liberation(s_etat_processus, s_objet_argument);
                    417: 
                    418:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    419:            s_objet_resultat) == d_erreur)
                    420:    {
                    421:        return;
                    422:    }
                    423: 
                    424:    return;
                    425: }
                    426: 
1.36      bertrand  427: 
                    428: /*
                    429: ================================================================================
                    430:   Fonction 'forall'
                    431: ================================================================================
                    432:   Entrées : structure processus
                    433: --------------------------------------------------------------------------------
                    434:   Sorties :
                    435: --------------------------------------------------------------------------------
                    436:   Effets de bord : néant
                    437: ================================================================================
                    438: */
                    439: 
                    440: void
                    441: instruction_forall(struct_processus *s_etat_processus)
                    442: {
                    443:    struct_objet                        *s_objet_1;
                    444:    struct_objet                        *s_objet_2;
                    445: 
                    446:    struct_variable                     s_variable;
                    447: 
                    448:    unsigned char                       instruction_valide;
                    449:    unsigned char                       *tampon;
                    450:    unsigned char                       test_instruction;
                    451: 
                    452:     (*s_etat_processus).erreur_execution = d_ex;
                    453: 
                    454:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    455:    {
                    456:        printf("\n  FORALL ");
                    457: 
                    458:        if ((*s_etat_processus).langue == 'F')
                    459:        {
                    460:            printf("(boucle définie sur un objet)\n\n");
                    461:        }
                    462:        else
                    463:        {
                    464:            printf("(define a object-based loop)\n\n");
                    465:        }
                    466: 
                    467:        if ((*s_etat_processus).langue == 'F')
                    468:        {
                    469:            printf("  Utilisation :\n\n");
                    470:        }
                    471:        else
                    472:        {
                    473:            printf("  Usage:\n\n");
                    474:        }
                    475: 
                    476:        printf("    %s/%s FORALL (variable)\n", d_LST, d_TAB);
                    477:        printf("        (expression)\n");
1.37      bertrand  478:        printf("        [EXIT]/[CYCLE]\n");
                    479:        printf("        ...\n");
1.36      bertrand  480:        printf("    NEXT\n");
                    481:        return;
                    482:    }
                    483:    else if ((*s_etat_processus).test_instruction == 'Y')
                    484:    {
                    485:        (*s_etat_processus).nombre_arguments = -1;
                    486:        return;
                    487:    }
                    488: 
                    489:    if ((*s_etat_processus).erreur_systeme != d_es)
                    490:    {
                    491:        return;
                    492:    }
                    493: 
                    494:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    495:    {
                    496:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    497:        {
                    498:            return;
                    499:        }
                    500:    }
                    501: 
                    502:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    503:            &s_objet_1) == d_erreur)
                    504:    {
                    505:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    506:        return;
                    507:    }
                    508: 
                    509:    if (((*s_objet_1).type != LST) && ((*s_objet_1).type != TBL))
                    510:    {
                    511:        liberation(s_etat_processus, s_objet_1);
                    512: 
                    513:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                    514:        return;
                    515:    }
                    516: 
                    517:    tampon = (*s_etat_processus).instruction_courante;
                    518:    test_instruction = (*s_etat_processus).test_instruction;
                    519:    instruction_valide = (*s_etat_processus).instruction_valide;
                    520:    (*s_etat_processus).test_instruction = 'Y';
                    521: 
                    522:    empilement_pile_systeme(s_etat_processus);
                    523: 
                    524:    if ((*s_etat_processus).erreur_systeme != d_es)
                    525:    {
                    526:        return;
                    527:    }
                    528: 
                    529:    if ((*s_etat_processus).mode_execution_programme == 'Y')
                    530:    {
                    531:        if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
                    532:        {
                    533:            return;
                    534:        }
                    535: 
                    536:        analyse(s_etat_processus, NULL);
                    537: 
                    538:        if ((*s_etat_processus).instruction_valide == 'Y')
                    539:        {
                    540:            liberation(s_etat_processus, s_objet_1);
                    541:            free((*s_etat_processus).instruction_courante);
                    542:            (*s_etat_processus).instruction_courante = tampon;
                    543: 
                    544:            depilement_pile_systeme(s_etat_processus);
                    545: 
                    546:            (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
                    547:            return;
                    548:        }
                    549: 
                    550:        recherche_type(s_etat_processus);
                    551: 
                    552:        free((*s_etat_processus).instruction_courante);
                    553:        (*s_etat_processus).instruction_courante = tampon;
                    554: 
                    555:        if ((*s_etat_processus).erreur_execution != d_ex)
                    556:        {
                    557:            depilement_pile_systeme(s_etat_processus);
                    558:            liberation(s_etat_processus, s_objet_1);
                    559:            return;
                    560:        }
                    561: 
                    562:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    563:                &s_objet_2) == d_erreur)
                    564:        {
                    565:            liberation(s_etat_processus, s_objet_1);
                    566: 
                    567:            depilement_pile_systeme(s_etat_processus);
                    568:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    569:            return;
                    570:        }
                    571: 
                    572:        (*(*s_etat_processus).l_base_pile_systeme)
                    573:                .origine_routine_evaluation = 'N';
                    574:    }
                    575:    else
                    576:    {
                    577:        if ((*s_etat_processus).expression_courante == NULL)
                    578:        {
                    579:            depilement_pile_systeme(s_etat_processus);
                    580: 
                    581:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    582:            return;
                    583:        }
                    584: 
                    585:        (*s_etat_processus).expression_courante = (*(*s_etat_processus)
                    586:                .expression_courante).suivant;
                    587: 
                    588:        if ((s_objet_2 = copie_objet(s_etat_processus,
                    589:                (*(*s_etat_processus).expression_courante)
                    590:                .donnee, 'P')) == NULL)
                    591:        {
                    592:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    593:            return;
                    594:        }
                    595: 
                    596:        (*(*s_etat_processus).l_base_pile_systeme)
                    597:                .origine_routine_evaluation = 'Y';
                    598:    }
                    599: 
                    600:    if ((*s_objet_2).type != NOM)
                    601:    {
                    602:        liberation(s_etat_processus, s_objet_1);
                    603:        depilement_pile_systeme(s_etat_processus);
                    604: 
                    605:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                    606:        return;
                    607:    }
                    608:    else if ((*((struct_nom *) (*s_objet_2).objet)).symbole == d_vrai)
                    609:    {
                    610:        liberation(s_etat_processus, s_objet_1);
                    611:        depilement_pile_systeme(s_etat_processus);
                    612: 
                    613:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                    614:        return;
                    615:    }
                    616: 
                    617:    (*s_etat_processus).niveau_courant++;
                    618:    (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'A';
                    619: 
                    620:    if ((s_variable.nom = malloc((strlen(
                    621:            (*((struct_nom *) (*s_objet_2).objet)).nom) + 1) *
                    622:            sizeof(unsigned char))) == NULL)
                    623:    {
                    624:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    625:        return;
                    626:    }
                    627: 
                    628:    strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_2).objet)).nom);
                    629:    s_variable.niveau = (*s_etat_processus).niveau_courant;
                    630: 
                    631:    if ((*s_objet_1).type == LST)
                    632:    {
                    633:        if ((*s_objet_1).objet == NULL)
                    634:        {
                    635:            // La liste est vide. On doit sauter au NEXT correspondant.
                    636:            liberation(s_etat_processus, s_objet_1);
                    637:            liberation(s_etat_processus, s_objet_2);
                    638:            free(s_variable.nom);
                    639: 
                    640:            if (((*(*s_etat_processus).l_base_pile_systeme)
                    641:                    .limite_indice_boucle = allocation(s_etat_processus, NON))
                    642:                    == NULL)
                    643:            {
                    644:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    645:                return;
                    646:            }
                    647: 
                    648:            (*s_etat_processus).test_instruction = test_instruction;
                    649:            (*s_etat_processus).instruction_valide = instruction_valide;
                    650: 
                    651:            instruction_cycle(s_etat_processus);
                    652:            return;
                    653:        }
                    654: 
                    655:        if ((s_variable.objet = copie_objet(s_etat_processus,
                    656:                (*((struct_liste_chainee *) (*s_objet_1).objet)).donnee, 'P'))
                    657:                == NULL)
                    658:        {
                    659:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    660:            return;
                    661:        }
                    662: 
                    663:        // Mémorisation de la position courante dans la liste
                    664: 
                    665:        if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
                    666:                allocation(s_etat_processus, NON)) == NULL)
                    667:        {
                    668:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    669:            return;
                    670:        }
                    671: 
                    672:        (*(*(*s_etat_processus).l_base_pile_systeme).indice_boucle).objet =
                    673:                (struct_objet *) (*s_objet_1).objet;
                    674:    }
                    675:    else
                    676:    {
                    677:        if ((*((struct_tableau *) (*s_objet_1).objet)).nombre_elements == 0)
                    678:        {
                    679:            // La table est vide, il convient de sauter au NEXT correspondant.
                    680:            liberation(s_etat_processus, s_objet_1);
                    681:            liberation(s_etat_processus, s_objet_2);
                    682:            free(s_variable.nom);
                    683: 
                    684:            if (((*(*s_etat_processus).l_base_pile_systeme)
                    685:                    .limite_indice_boucle = allocation(s_etat_processus, NON))
                    686:                    == NULL)
                    687:            {
                    688:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    689:                return;
                    690:            }
                    691: 
                    692:            (*s_etat_processus).test_instruction = test_instruction;
                    693:            (*s_etat_processus).instruction_valide = instruction_valide;
                    694: 
                    695:            instruction_cycle(s_etat_processus);
                    696:            return;
                    697:        }
                    698: 
                    699:        if ((s_variable.objet = copie_objet(s_etat_processus,
                    700:                (*((struct_tableau *) (*s_objet_1).objet)).elements[0], 'P'))
                    701:                == NULL)
                    702:        {
                    703:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    704:            return;
                    705:        }
                    706: 
                    707:        // Création d'un objet de type entier contenant la position
                    708:        // de l'élément courant dans la table.
                    709: 
                    710:        if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
                    711:                allocation(s_etat_processus, INT)) == NULL)
                    712:        {
                    713:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    714:            return;
                    715:        }
                    716: 
                    717:        (*((integer8 *) (*(*(*s_etat_processus).l_base_pile_systeme)
                    718:                .indice_boucle).objet)) = 0;
                    719:    }
                    720: 
                    721:    if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') == d_erreur)
                    722:    {
                    723:        return;
                    724:    }
                    725: 
                    726:    liberation(s_etat_processus, s_objet_2);
                    727: 
                    728:    (*s_etat_processus).test_instruction = test_instruction;
                    729:    (*s_etat_processus).instruction_valide = instruction_valide;
                    730: 
                    731:    (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
                    732: 
                    733:    if ((*s_etat_processus).mode_execution_programme == 'Y')
                    734:    {
                    735:        (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
                    736:                (*s_etat_processus).position_courante;
                    737:    }
                    738:    else
                    739:    {
                    740:        (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
                    741:                (*s_etat_processus).expression_courante;
                    742:    }
                    743: 
                    744:    if (((*(*s_etat_processus).l_base_pile_systeme).nom_variable =
                    745:            malloc((strlen(s_variable.nom) + 1) *
                    746:            sizeof(unsigned char))) == NULL)
                    747:    {
                    748:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    749:        return;
                    750:    }
                    751: 
                    752:    strcpy((*(*s_etat_processus).l_base_pile_systeme).nom_variable,
                    753:            s_variable.nom);
                    754: 
                    755:    return;
                    756: }
                    757: 
1.1       bertrand  758: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>