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

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: 
1.41    ! bertrand  476:        printf("    %s FORALL (variable)\n", d_LST);
        !           477:        printf("        (expression)\n");
        !           478:        printf("        [EXIT]/[CYCLE]\n");
        !           479:        printf("        ...\n");
        !           480:        printf("    NEXT\n\n");
        !           481: 
        !           482:        printf("    %s FORALL (variable)\n", d_TAB);
1.36      bertrand  483:        printf("        (expression)\n");
1.37      bertrand  484:        printf("        [EXIT]/[CYCLE]\n");
                    485:        printf("        ...\n");
1.36      bertrand  486:        printf("    NEXT\n");
                    487:        return;
                    488:    }
                    489:    else if ((*s_etat_processus).test_instruction == 'Y')
                    490:    {
                    491:        (*s_etat_processus).nombre_arguments = -1;
                    492:        return;
                    493:    }
                    494: 
                    495:    if ((*s_etat_processus).erreur_systeme != d_es)
                    496:    {
                    497:        return;
                    498:    }
                    499: 
                    500:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    501:    {
                    502:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    503:        {
                    504:            return;
                    505:        }
                    506:    }
                    507: 
                    508:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    509:            &s_objet_1) == d_erreur)
                    510:    {
                    511:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    512:        return;
                    513:    }
                    514: 
                    515:    if (((*s_objet_1).type != LST) && ((*s_objet_1).type != TBL))
                    516:    {
                    517:        liberation(s_etat_processus, s_objet_1);
                    518: 
                    519:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                    520:        return;
                    521:    }
                    522: 
                    523:    tampon = (*s_etat_processus).instruction_courante;
                    524:    test_instruction = (*s_etat_processus).test_instruction;
                    525:    instruction_valide = (*s_etat_processus).instruction_valide;
                    526:    (*s_etat_processus).test_instruction = 'Y';
                    527: 
                    528:    empilement_pile_systeme(s_etat_processus);
                    529: 
                    530:    if ((*s_etat_processus).erreur_systeme != d_es)
                    531:    {
                    532:        return;
                    533:    }
                    534: 
                    535:    if ((*s_etat_processus).mode_execution_programme == 'Y')
                    536:    {
                    537:        if (recherche_instruction_suivante(s_etat_processus) == d_erreur)
                    538:        {
                    539:            return;
                    540:        }
                    541: 
                    542:        analyse(s_etat_processus, NULL);
                    543: 
                    544:        if ((*s_etat_processus).instruction_valide == 'Y')
                    545:        {
                    546:            liberation(s_etat_processus, s_objet_1);
                    547:            free((*s_etat_processus).instruction_courante);
                    548:            (*s_etat_processus).instruction_courante = tampon;
                    549: 
                    550:            depilement_pile_systeme(s_etat_processus);
                    551: 
                    552:            (*s_etat_processus).erreur_execution = d_ex_nom_reserve;
                    553:            return;
                    554:        }
                    555: 
                    556:        recherche_type(s_etat_processus);
                    557: 
                    558:        free((*s_etat_processus).instruction_courante);
                    559:        (*s_etat_processus).instruction_courante = tampon;
                    560: 
                    561:        if ((*s_etat_processus).erreur_execution != d_ex)
                    562:        {
                    563:            depilement_pile_systeme(s_etat_processus);
                    564:            liberation(s_etat_processus, s_objet_1);
                    565:            return;
                    566:        }
                    567: 
                    568:        if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    569:                &s_objet_2) == d_erreur)
                    570:        {
                    571:            liberation(s_etat_processus, s_objet_1);
                    572: 
                    573:            depilement_pile_systeme(s_etat_processus);
                    574:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    575:            return;
                    576:        }
                    577: 
                    578:        (*(*s_etat_processus).l_base_pile_systeme)
                    579:                .origine_routine_evaluation = 'N';
                    580:    }
                    581:    else
                    582:    {
                    583:        if ((*s_etat_processus).expression_courante == NULL)
                    584:        {
                    585:            depilement_pile_systeme(s_etat_processus);
                    586: 
                    587:            (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    588:            return;
                    589:        }
                    590: 
                    591:        (*s_etat_processus).expression_courante = (*(*s_etat_processus)
                    592:                .expression_courante).suivant;
                    593: 
                    594:        if ((s_objet_2 = copie_objet(s_etat_processus,
                    595:                (*(*s_etat_processus).expression_courante)
                    596:                .donnee, 'P')) == NULL)
                    597:        {
                    598:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    599:            return;
                    600:        }
                    601: 
                    602:        (*(*s_etat_processus).l_base_pile_systeme)
                    603:                .origine_routine_evaluation = 'Y';
                    604:    }
                    605: 
                    606:    if ((*s_objet_2).type != NOM)
                    607:    {
                    608:        liberation(s_etat_processus, s_objet_1);
                    609:        depilement_pile_systeme(s_etat_processus);
                    610: 
                    611:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                    612:        return;
                    613:    }
                    614:    else if ((*((struct_nom *) (*s_objet_2).objet)).symbole == d_vrai)
                    615:    {
                    616:        liberation(s_etat_processus, s_objet_1);
                    617:        depilement_pile_systeme(s_etat_processus);
                    618: 
                    619:        (*s_etat_processus).erreur_execution = d_ex_erreur_traitement_boucle;
                    620:        return;
                    621:    }
                    622: 
                    623:    (*s_etat_processus).niveau_courant++;
                    624:    (*(*s_etat_processus).l_base_pile_systeme).type_cloture = 'A';
                    625: 
                    626:    if ((s_variable.nom = malloc((strlen(
                    627:            (*((struct_nom *) (*s_objet_2).objet)).nom) + 1) *
                    628:            sizeof(unsigned char))) == NULL)
                    629:    {
                    630:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    631:        return;
                    632:    }
                    633: 
                    634:    strcpy(s_variable.nom, (*((struct_nom *) (*s_objet_2).objet)).nom);
                    635:    s_variable.niveau = (*s_etat_processus).niveau_courant;
                    636: 
                    637:    if ((*s_objet_1).type == LST)
                    638:    {
                    639:        if ((*s_objet_1).objet == NULL)
                    640:        {
                    641:            // La liste est vide. On doit sauter au NEXT correspondant.
                    642:            liberation(s_etat_processus, s_objet_1);
                    643:            liberation(s_etat_processus, s_objet_2);
                    644:            free(s_variable.nom);
                    645: 
                    646:            if (((*(*s_etat_processus).l_base_pile_systeme)
                    647:                    .limite_indice_boucle = allocation(s_etat_processus, NON))
                    648:                    == NULL)
                    649:            {
                    650:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    651:                return;
                    652:            }
                    653: 
                    654:            (*s_etat_processus).test_instruction = test_instruction;
                    655:            (*s_etat_processus).instruction_valide = instruction_valide;
                    656: 
                    657:            instruction_cycle(s_etat_processus);
                    658:            return;
                    659:        }
                    660: 
                    661:        if ((s_variable.objet = copie_objet(s_etat_processus,
                    662:                (*((struct_liste_chainee *) (*s_objet_1).objet)).donnee, 'P'))
                    663:                == NULL)
                    664:        {
                    665:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    666:            return;
                    667:        }
                    668: 
                    669:        // Mémorisation de la position courante dans la liste
                    670: 
                    671:        if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
                    672:                allocation(s_etat_processus, NON)) == NULL)
                    673:        {
                    674:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    675:            return;
                    676:        }
                    677: 
                    678:        (*(*(*s_etat_processus).l_base_pile_systeme).indice_boucle).objet =
                    679:                (struct_objet *) (*s_objet_1).objet;
                    680:    }
                    681:    else
                    682:    {
                    683:        if ((*((struct_tableau *) (*s_objet_1).objet)).nombre_elements == 0)
                    684:        {
                    685:            // La table est vide, il convient de sauter au NEXT correspondant.
                    686:            liberation(s_etat_processus, s_objet_1);
                    687:            liberation(s_etat_processus, s_objet_2);
                    688:            free(s_variable.nom);
                    689: 
                    690:            if (((*(*s_etat_processus).l_base_pile_systeme)
                    691:                    .limite_indice_boucle = allocation(s_etat_processus, NON))
                    692:                    == NULL)
                    693:            {
                    694:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    695:                return;
                    696:            }
                    697: 
                    698:            (*s_etat_processus).test_instruction = test_instruction;
                    699:            (*s_etat_processus).instruction_valide = instruction_valide;
                    700: 
                    701:            instruction_cycle(s_etat_processus);
                    702:            return;
                    703:        }
                    704: 
                    705:        if ((s_variable.objet = copie_objet(s_etat_processus,
                    706:                (*((struct_tableau *) (*s_objet_1).objet)).elements[0], 'P'))
                    707:                == NULL)
                    708:        {
                    709:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    710:            return;
                    711:        }
                    712: 
                    713:        // Création d'un objet de type entier contenant la position
                    714:        // de l'élément courant dans la table.
                    715: 
                    716:        if (((*(*s_etat_processus).l_base_pile_systeme).indice_boucle =
                    717:                allocation(s_etat_processus, INT)) == NULL)
                    718:        {
                    719:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    720:            return;
                    721:        }
                    722: 
                    723:        (*((integer8 *) (*(*(*s_etat_processus).l_base_pile_systeme)
                    724:                .indice_boucle).objet)) = 0;
                    725:    }
                    726: 
                    727:    if (creation_variable(s_etat_processus, &s_variable, 'V', 'P') == d_erreur)
                    728:    {
                    729:        return;
                    730:    }
                    731: 
                    732:    liberation(s_etat_processus, s_objet_2);
                    733: 
                    734:    (*s_etat_processus).test_instruction = test_instruction;
                    735:    (*s_etat_processus).instruction_valide = instruction_valide;
                    736: 
                    737:    (*(*s_etat_processus).l_base_pile_systeme).limite_indice_boucle = s_objet_1;
                    738: 
                    739:    if ((*s_etat_processus).mode_execution_programme == 'Y')
                    740:    {
                    741:        (*(*s_etat_processus).l_base_pile_systeme).adresse_retour =
                    742:                (*s_etat_processus).position_courante;
                    743:    }
                    744:    else
                    745:    {
                    746:        (*(*s_etat_processus).l_base_pile_systeme).pointeur_objet_retour =
                    747:                (*s_etat_processus).expression_courante;
                    748:    }
                    749: 
                    750:    if (((*(*s_etat_processus).l_base_pile_systeme).nom_variable =
                    751:            malloc((strlen(s_variable.nom) + 1) *
                    752:            sizeof(unsigned char))) == NULL)
                    753:    {
                    754:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    755:        return;
                    756:    }
                    757: 
                    758:    strcpy((*(*s_etat_processus).l_base_pile_systeme).nom_variable,
                    759:            s_variable.nom);
                    760: 
                    761:    return;
                    762: }
                    763: 
1.1       bertrand  764: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>