Annotation of rpl/src/instructions_d6.c, revision 1.36

1.1       bertrand    1: /*
                      2: ================================================================================
1.36    ! bertrand    3:   RPL/2 (R) version 4.1.11
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 'dupcntxt'
                     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_dupcntxt(struct_processus *s_etat_processus)
                     40: {
                     41:    struct_objet            *s_objet;
                     42:    struct_objet            *s_pile;
                     43: 
                     44:    (*s_etat_processus).erreur_execution = d_ex;
                     45: 
                     46:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     47:    {
                     48:        printf("\n  DUPCNTXT ");
                     49: 
                     50:        if ((*s_etat_processus).langue == 'F')
                     51:        {
                     52:            printf("(duplication du contexte)\n\n");
                     53:            printf("  Aucun argument\n");
                     54:        }
                     55:        else
                     56:        {
                     57:            printf("(context duplication)\n\n");
                     58:            printf("  No argument\n");
                     59:        }
                     60: 
                     61:        return;
                     62:    }
                     63:    else if ((*s_etat_processus).test_instruction == 'Y')
                     64:    {
                     65:        (*s_etat_processus).nombre_arguments = -1;
                     66:        return;
                     67:    }
                     68: 
                     69:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                     70:    {
                     71:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                     72:        {
                     73:            return;
                     74:        }
                     75:    }
                     76: 
                     77:    if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
                     78:    {
                     79:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                     80:        return;
                     81:    }
                     82: 
                     83:    (*s_objet).objet = (*s_etat_processus).l_base_pile;
                     84: 
                     85:    if ((s_pile = copie_objet(s_etat_processus, s_objet, 'N')) == NULL)
                     86:    {
                     87:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                     88:        return;
                     89:    }
                     90: 
                     91:    if (empilement(s_etat_processus, &((*s_etat_processus).
                     92:            l_base_pile_contextes), s_objet) == d_erreur)
                     93:    {
                     94:        return;
                     95:    }
                     96: 
                     97:    if ((s_objet = allocation(s_etat_processus, INT)) == NULL)
                     98:    {
                     99:        (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    100:        return;
                    101:    }
                    102: 
                    103:    (*((integer8 *) (*s_objet).objet)) = (*s_etat_processus)
                    104:            .hauteur_pile_operationnelle;
                    105: 
                    106:    if (empilement(s_etat_processus, &((*s_etat_processus)
                    107:            .l_base_pile_taille_contextes), s_objet) == d_erreur)
                    108:    {
                    109:        return;
                    110:    }
                    111: 
                    112:    /*
                    113:     * Copie de la pile opérationnelle
                    114:     */
                    115: 
                    116:    (*s_etat_processus).l_base_pile = (*s_pile).objet;
                    117: 
                    118:    (*s_pile).objet = NULL;
                    119:    liberation(s_etat_processus, s_pile);
                    120: 
                    121:    return;
                    122: }
                    123: 
                    124: 
                    125: /*
                    126: ================================================================================
                    127:   Fonction 'dropcntxt'
                    128: ================================================================================
                    129:   Entrées : pointeur sur une structure struct_processus
                    130: --------------------------------------------------------------------------------
                    131:   Sorties :
                    132: --------------------------------------------------------------------------------
                    133:   Effets de bord : néant
                    134: ================================================================================
                    135: */
                    136: 
                    137: void
                    138: instruction_dropcntxt(struct_processus *s_etat_processus)
                    139: {
                    140:    struct_objet                    *s_objet;
                    141: 
                    142:    (*s_etat_processus).erreur_execution = d_ex;
                    143: 
                    144:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    145:    {
                    146:        printf("\n  DROPCNTXT ");
                    147: 
                    148:        if ((*s_etat_processus).langue == 'F')
                    149:        {
                    150:            printf("(effacement d'un contexte)\n\n");
                    151:            printf("  Aucun argument\n");
                    152:        }
                    153:        else
                    154:        {
                    155:            printf("(drops context)\n\n");
                    156:            printf("  No argument\n");
                    157:        }
                    158: 
                    159:        return;
                    160:    }
                    161:    else if ((*s_etat_processus).test_instruction == 'Y')
                    162:    {
                    163:        (*s_etat_processus).nombre_arguments = -1;
                    164:        return;
                    165:    }
                    166: 
                    167:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    168:    {
                    169:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                    170:        {
                    171:            return;
                    172:        }
                    173:    }
                    174: 
                    175:    if (((*s_etat_processus).l_base_pile_contextes == NULL) ||
                    176:            ((*s_etat_processus).l_base_pile_taille_contextes == NULL))
                    177:    {
                    178:        (*s_etat_processus).erreur_execution = d_ex_contexte;
                    179:        return;
                    180:    }
                    181: 
                    182:    if (depilement(s_etat_processus, &((*s_etat_processus)
                    183:            .l_base_pile_contextes), &s_objet) == d_erreur)
                    184:    {
                    185:        return;
                    186:    }
                    187: 
                    188:    liberation(s_etat_processus, s_objet);
                    189: 
                    190:    if (depilement(s_etat_processus, &((*s_etat_processus)
                    191:            .l_base_pile_taille_contextes), &s_objet) == d_erreur)
                    192:    {
                    193:        return;
                    194:    }
                    195: 
                    196:    liberation(s_etat_processus, s_objet);
                    197: 
                    198:    return;
                    199: }
                    200: 
                    201: 
                    202: /*
                    203: ================================================================================
                    204:   Fonction 'dgtiz'
                    205: ================================================================================
                    206:   Entrées : pointeur sur une structure struct_processus
                    207: --------------------------------------------------------------------------------
                    208:   Sorties :
                    209: --------------------------------------------------------------------------------
                    210:   Effets de bord : néant
                    211: ================================================================================
                    212: */
                    213: 
                    214: void
                    215: instruction_dgtiz(struct_processus *s_etat_processus)
                    216: {
                    217:    (*s_etat_processus).erreur_execution = d_ex;
                    218: 
                    219:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    220:    {
                    221:        printf("\n  DGTIZ ");
                    222: 
                    223:        if ((*s_etat_processus).langue == 'F')
                    224:        {
                    225:            printf("(mouse support in plot functions)\n\n");
                    226:            printf("  Aucun argument\n");
                    227:        }
                    228:        else
                    229:        {
                    230:            printf("(support de la souris dans les fonctions graphiques)\n\n");
                    231:            printf("  No argument\n");
                    232:        }
                    233: 
                    234:        return;
                    235:    }
                    236:    else if ((*s_etat_processus).test_instruction == 'Y')
                    237:    {
                    238:        (*s_etat_processus).nombre_arguments = -1;
                    239:        return;
                    240:    }
                    241: 
                    242:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    243:    {
                    244:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                    245:        {
                    246:            return;
                    247:        }
                    248:    }
                    249: 
                    250:    if ((*s_etat_processus).fichiers_graphiques != NULL)
                    251:    {
                    252:        (*s_etat_processus).souris_active = d_vrai;
                    253:        appel_gnuplot(s_etat_processus, 'N');
                    254:        (*s_etat_processus).souris_active = d_faux;
                    255:    }
                    256: 
                    257:    return;
                    258: }
                    259: 
                    260: 
                    261: /*
                    262: ================================================================================
                    263:   Fonction 'daemonize'
                    264: ================================================================================
                    265:   Entrées : pointeur sur une structure struct_processus
                    266: --------------------------------------------------------------------------------
                    267:   Sorties :
                    268: --------------------------------------------------------------------------------
                    269:   Effets de bord : néant
                    270: ================================================================================
                    271: */
                    272: 
                    273: void
                    274: instruction_daemonize(struct_processus *s_etat_processus)
                    275: {
                    276:    (*s_etat_processus).erreur_execution = d_ex;
                    277: 
                    278:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    279:    {
                    280:        printf("\n  DAEMONIZE ");
                    281: 
                    282:        if ((*s_etat_processus).langue == 'F')
                    283:        {
                    284:            printf("(basculement en mode daemon)\n\n");
                    285:            printf("  Aucun argument\n");
                    286:        }
                    287:        else
                    288:        {
                    289:            printf("(convert to daemon)\n\n");
                    290:            printf("  No argument\n");
                    291:        }
                    292: 
                    293:        return;
                    294:    }
                    295:    else if ((*s_etat_processus).test_instruction == 'Y')
                    296:    {
                    297:        (*s_etat_processus).nombre_arguments = -1;
                    298:        return;
                    299:    }
                    300: 
                    301:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    302:    {
                    303:        if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
                    304:        {
                    305:            return;
                    306:        }
                    307:    }
                    308: 
                    309:    if (((*s_etat_processus).var_volatile_processus_pere == -1) &&
                    310:            ((*s_etat_processus).l_base_pile_processus == NULL))
                    311:    {
                    312:        lancement_daemon(s_etat_processus);
                    313:    }
                    314:    else
                    315:    {
                    316:        (*s_etat_processus).erreur_execution = d_ex_daemon;
                    317:        return;
                    318:    }
                    319: 
                    320:    return;
                    321: }
                    322: 
                    323: 
                    324: /*
                    325: ================================================================================
                    326:   Fonction 'diag->'
                    327: ================================================================================
                    328:   Entrées : pointeur sur une structure struct_processus
                    329: --------------------------------------------------------------------------------
                    330:   Sorties :
                    331: --------------------------------------------------------------------------------
                    332:   Effets de bord : néant
                    333: ================================================================================
                    334: */
                    335: 
                    336: void
                    337: instruction_diag_fleche(struct_processus *s_etat_processus)
                    338: {
                    339:    struct_objet                *s_objet_argument;
                    340:    struct_objet                *s_objet_resultat;
                    341: 
                    342:    unsigned long               i;
                    343:    unsigned long               j;
                    344: 
                    345:    (*s_etat_processus).erreur_execution = d_ex;
                    346: 
                    347:    if ((*s_etat_processus).affichage_arguments == 'Y')
                    348:    {
                    349:        printf("\n  DIAG-> ");
                    350: 
                    351:        if ((*s_etat_processus).langue == 'F')
                    352:        {
                    353:            printf("(conversion d'une matrice diagonale en vecteur)\n\n");
                    354:        }
                    355:        else
                    356:        {
                    357:            printf("(diagonal matrix to vector conversion)\n\n");
                    358:        }
                    359: 
                    360:        printf("    1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
                    361:        printf("->  1: %s, %s, %s\n", d_VIN, d_VRL, d_VCX);
                    362: 
                    363:        return;
                    364:    }
                    365:    else if ((*s_etat_processus).test_instruction == 'Y')
                    366:    {
                    367:        (*s_etat_processus).nombre_arguments = -1;
                    368:        return;
                    369:    }
                    370: 
                    371:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                    372:    {
                    373:        if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
                    374:        {
                    375:            return;
                    376:        }
                    377:    }
                    378: 
                    379:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    380:            &s_objet_argument) == d_erreur)
                    381:    {
                    382:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    383:        return;
                    384:    }
                    385: 
                    386:    /*
                    387:     * Conversion d'une matrice
                    388:     */
                    389: 
                    390:    if ((*s_objet_argument).type == MIN)
                    391:    {
                    392:        if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
                    393:                (*((struct_matrice *) (*s_objet_argument).objet))
                    394:                .nombre_colonnes)
                    395:        {
                    396:            (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
                    397: 
                    398:            liberation(s_etat_processus, s_objet_argument);
                    399:            return;
                    400:        }
                    401: 
                    402:        if ((s_objet_resultat = allocation(s_etat_processus, VIN)) == NULL)
                    403:        {
                    404:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    405:            return;
                    406:        }
                    407: 
                    408:        (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
                    409:                (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
                    410: 
                    411:        if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
                    412:                = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
                    413:                .taille * sizeof(integer8))) == NULL)
                    414:        {
                    415:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    416:            return;
                    417:        }
                    418: 
                    419:        for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
                    420:                .nombre_lignes; i++)
                    421:        {
                    422:            for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
                    423:                    .nombre_colonnes; j++)
                    424:            {
                    425:                if (i != j)
                    426:                {
                    427:                    if (((integer8 **) (*((struct_matrice *) (*s_objet_argument)
                    428:                            .objet)).tableau)[i][j] != 0)
                    429:                    {
                    430:                        liberation(s_etat_processus, s_objet_argument);
                    431:                        liberation(s_etat_processus, s_objet_resultat);
                    432: 
                    433:                        (*s_etat_processus).erreur_execution =
                    434:                                d_ex_matrice_non_diagonale;
                    435:                        return;
                    436:                    }
                    437:                }
                    438:                else
                    439:                {
                    440:                    ((integer8 *) (*((struct_vecteur *) (*s_objet_resultat)
                    441:                            .objet)).tableau)[i] = ((integer8 **)
                    442:                            (*((struct_matrice *) (*s_objet_argument)
                    443:                            .objet)).tableau)[i][j];
                    444:                }
                    445:            }
                    446:        }
                    447:    }
                    448:    else if ((*s_objet_argument).type == MRL)
                    449:    {
                    450:        if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
                    451:                (*((struct_matrice *) (*s_objet_argument).objet))
                    452:                .nombre_colonnes)
                    453:        {
                    454:            (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
                    455: 
                    456:            liberation(s_etat_processus, s_objet_argument);
                    457:            return;
                    458:        }
                    459: 
                    460:        if ((s_objet_resultat = allocation(s_etat_processus, VRL)) == NULL)
                    461:        {
                    462:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    463:            return;
                    464:        }
                    465: 
                    466:        (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
                    467:                (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
                    468: 
                    469:        if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
                    470:                = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
                    471:                .taille * sizeof(real8))) == NULL)
                    472:        {
                    473:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    474:            return;
                    475:        }
                    476: 
                    477:        for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
                    478:                .nombre_lignes; i++)
                    479:        {
                    480:            for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
                    481:                    .nombre_colonnes; j++)
                    482:            {
                    483:                if (i != j)
                    484:                {
                    485:                    if (((real8 **) (*((struct_matrice *) (*s_objet_argument)
                    486:                            .objet)).tableau)[i][j] != 0)
                    487:                    {
                    488:                        liberation(s_etat_processus, s_objet_argument);
                    489:                        liberation(s_etat_processus, s_objet_resultat);
                    490: 
                    491:                        (*s_etat_processus).erreur_execution =
                    492:                                d_ex_matrice_non_diagonale;
                    493:                        return;
                    494:                    }
                    495:                }
                    496:                else
                    497:                {
                    498:                    ((real8 *) (*((struct_vecteur *) (*s_objet_resultat)
                    499:                            .objet)).tableau)[i] = ((real8 **)
                    500:                            (*((struct_matrice *) (*s_objet_argument)
                    501:                            .objet)).tableau)[i][j];
                    502:                }
                    503:            }
                    504:        }
                    505:    }
                    506:    else if ((*s_objet_argument).type == MCX)
                    507:    {
                    508:        if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
                    509:                (*((struct_matrice *) (*s_objet_argument).objet))
                    510:                .nombre_colonnes)
                    511:        {
                    512:            (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
                    513: 
                    514:            liberation(s_etat_processus, s_objet_argument);
                    515:            return;
                    516:        }
                    517: 
                    518:        if ((s_objet_resultat = allocation(s_etat_processus, VCX)) == NULL)
                    519:        {
                    520:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    521:            return;
                    522:        }
                    523: 
                    524:        (*((struct_vecteur *) (*s_objet_resultat).objet)).taille =
                    525:                (*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes;
                    526: 
                    527:        if (((*((struct_vecteur *) (*s_objet_resultat).objet)).tableau
                    528:                = malloc((*((struct_vecteur *) (*s_objet_resultat).objet))
                    529:                .taille * sizeof(complex16))) == NULL)
                    530:        {
                    531:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    532:            return;
                    533:        }
                    534: 
                    535:        for(i = 0; i < (*((struct_matrice *) (*s_objet_argument).objet))
                    536:                .nombre_lignes; i++)
                    537:        {
                    538:            for(j = 0; j < (*((struct_matrice *) (*s_objet_argument).objet))
                    539:                    .nombre_colonnes; j++)
                    540:            {
                    541:                if (i != j)
                    542:                {
                    543:                    if ((((complex16 **) (*((struct_matrice *)
                    544:                            (*s_objet_argument).objet)).tableau)[i][j]
                    545:                            .partie_reelle != 0) ||
                    546:                            (((complex16 **) (*((struct_matrice *)
                    547:                            (*s_objet_argument).objet)).tableau)[i][j]
                    548:                            .partie_imaginaire != 0))
                    549:                    {
                    550:                        liberation(s_etat_processus, s_objet_argument);
                    551:                        liberation(s_etat_processus, s_objet_resultat);
                    552: 
                    553:                        (*s_etat_processus).erreur_execution =
                    554:                                d_ex_matrice_non_diagonale;
                    555:                        return;
                    556:                    }
                    557:                }
                    558:                else
                    559:                {
                    560:                    ((complex16 *) (*((struct_vecteur *) (*s_objet_resultat)
                    561:                            .objet)).tableau)[i] = ((complex16 **)
                    562:                            (*((struct_matrice *) (*s_objet_argument)
                    563:                            .objet)).tableau)[i][j];
                    564:                }
                    565:            }
                    566:        }
                    567:    }
                    568: 
                    569:    /*
                    570:     * Conversion impossible impossible
                    571:     */
                    572: 
                    573:    else
                    574:    {
                    575:        liberation(s_etat_processus, s_objet_argument);
                    576: 
                    577:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    578:        return;
                    579:    }
                    580: 
                    581:    liberation(s_etat_processus, s_objet_argument);
                    582: 
                    583:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    584:            s_objet_resultat) == d_erreur)
                    585:    {
                    586:        return;
                    587:    }
                    588: 
                    589:    return;
                    590: }
                    591: 
                    592: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>