Annotation of rpl/src/instructions_i4.c, revision 1.5

1.1       bertrand    1: /*
                      2: ================================================================================
1.5     ! bertrand    3:   RPL/2 (R) version 4.0.13
1.1       bertrand    4:   Copyright (C) 1989-2010 Dr. BERTRAND Joël
                      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: 
                     23: #include "rpl.conv.h"
                     24: 
                     25: 
                     26: /*
                     27: ================================================================================
                     28:   Fonction 'in'
                     29: ================================================================================
                     30:   Entrées :
                     31: --------------------------------------------------------------------------------
                     32:   Sorties :
                     33: --------------------------------------------------------------------------------
                     34:   Effets de bord : néant
                     35: ================================================================================
                     36: */
                     37: 
                     38: void
                     39: instruction_in(struct_processus *s_etat_processus)
                     40: {
                     41:    logical1                difference;
                     42: 
                     43:    struct_liste_chainee    *l_element_courant;
                     44: 
                     45:    struct_objet            *s_copie_1;
                     46:    struct_objet            *s_copie_2;
                     47:    struct_objet            *s_objet_argument_1;
                     48:    struct_objet            *s_objet_argument_2;
                     49:    struct_objet            *s_objet_resultat;
                     50:    struct_objet            *s_objet_resultat_intermediaire;
                     51: 
                     52:    (*s_etat_processus).erreur_execution = d_ex;
                     53: 
                     54:    if ((*s_etat_processus).affichage_arguments == 'Y')
                     55:    {
                     56:        printf("\n  IN ");
                     57: 
                     58:        if ((*s_etat_processus).langue == 'F')
                     59:        {
                     60:            printf("(test de l'appartenance à un ensemble)\n\n");
                     61:        }
                     62:        else
                     63:        {
                     64:            printf("(check membership)\n\n");
                     65:        }
                     66: 
                     67:        printf("    2: %s, %s, %s, %s, %s, %s,\n"
                     68:                "       %s, %s, %s, %s, %s,\n"
                     69:                "       %s, %s, %s, %s, %s,\n",
                     70:                d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
                     71:                d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
                     72:        printf("    1: %s\n", d_LST);
                     73:        printf("->  1: %s\n", d_INT);
                     74: 
                     75:        return;
                     76:    }
                     77:    else if ((*s_etat_processus).test_instruction == 'Y')
                     78:    {
                     79:        (*s_etat_processus).nombre_arguments = -1;
                     80:        return;
                     81:    }
                     82: 
                     83:    if (test_cfsf(s_etat_processus, 31) == d_vrai)
                     84:    {
                     85:        if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
                     86:        {
                     87:            return;
                     88:        }
                     89:    }
                     90: 
                     91:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                     92:            &s_objet_argument_1) == d_erreur)
                     93:    {
                     94:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                     95:        return;
                     96:    }
                     97: 
                     98:    if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                     99:            &s_objet_argument_2) == d_erreur)
                    100:    {
                    101:        liberation(s_etat_processus, s_objet_argument_1);
                    102: 
                    103:        (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    104:        return;
                    105:    }
                    106: 
                    107:    if (((*s_objet_argument_1).type == LST) &&
                    108:            (((*s_objet_argument_2).type == INT) ||
                    109:            ((*s_objet_argument_2).type == REL) ||
                    110:            ((*s_objet_argument_2).type == CPL) ||
                    111:            ((*s_objet_argument_2).type == VIN) ||
                    112:            ((*s_objet_argument_2).type == VRL) ||
                    113:            ((*s_objet_argument_2).type == VCX) ||
                    114:            ((*s_objet_argument_2).type == MIN) ||
                    115:            ((*s_objet_argument_2).type == MRL) ||
                    116:            ((*s_objet_argument_2).type == MCX) ||
                    117:            ((*s_objet_argument_2).type == TAB) ||
                    118:            ((*s_objet_argument_2).type == BIN) ||
                    119:            ((*s_objet_argument_2).type == NOM) ||
                    120:            ((*s_objet_argument_2).type == CHN) ||
                    121:            ((*s_objet_argument_2).type == LST) ||
                    122:            ((*s_objet_argument_2).type == ALG) ||
                    123:            ((*s_objet_argument_2).type == RPN)))
                    124:    {
                    125:        if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
                    126:        {
                    127:            (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    128:            return;
                    129:        }
                    130: 
                    131:        l_element_courant = (struct_liste_chainee *)
                    132:                (*s_objet_argument_1).objet;
                    133: 
                    134:        difference = d_vrai;
                    135: 
                    136:        while((difference == d_vrai) && (l_element_courant != NULL))
                    137:        {
                    138:            if ((s_copie_1 = copie_objet(s_etat_processus,
                    139:                    (*l_element_courant).donnee, 'P')) == NULL)
                    140:            {
                    141:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    142:                return;
                    143:            }
                    144: 
                    145:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    146:                    s_copie_1) == d_erreur)
                    147:            {
                    148:                return;
                    149:            }
                    150: 
                    151:            if ((s_copie_2 = copie_objet(s_etat_processus,
                    152:                    s_objet_argument_2, 'P')) == NULL)
                    153:            {
                    154:                (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
                    155:                return;
                    156:            }
                    157: 
                    158:            if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    159:                    s_copie_2) == d_erreur)
                    160:            {
                    161:                return;
                    162:            }
                    163: 
                    164:            instruction_same(s_etat_processus);
                    165: 
                    166:            if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    167:                     &s_objet_resultat_intermediaire) == d_erreur)
                    168:            {
                    169:                liberation(s_etat_processus, s_objet_argument_1);
                    170:                liberation(s_etat_processus, s_objet_argument_2);
                    171:                liberation(s_etat_processus, s_objet_resultat);
                    172: 
                    173:                (*s_etat_processus).erreur_execution = d_ex_manque_argument;
                    174:                return;
                    175:            }
                    176: 
                    177:            if ((*s_objet_resultat_intermediaire).type != INT)
                    178:            {
                    179:                liberation(s_etat_processus, s_objet_argument_1);
                    180:                liberation(s_etat_processus, s_objet_argument_2);
                    181:                liberation(s_etat_processus, s_objet_resultat);
                    182: 
                    183:                (*s_etat_processus).erreur_execution =
                    184:                        d_ex_erreur_type_argument;
                    185:                return;
                    186:            }
                    187: 
                    188:            difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
                    189:                    .objet)) == 0) ? d_vrai : d_faux;
                    190: 
                    191:            liberation(s_etat_processus, s_objet_resultat_intermediaire);
                    192:            l_element_courant = (*l_element_courant).suivant;
                    193:        }
                    194: 
                    195:        if (difference == d_vrai)
                    196:        {
                    197:            (*((integer8 *) (*s_objet_resultat).objet)) = 0;
                    198:        }
                    199:        else
                    200:        {
                    201:            (*((integer8 *) (*s_objet_resultat).objet)) = -1;
                    202:        }
                    203:    }
                    204:    else
                    205:    {
                    206:        liberation(s_etat_processus, s_objet_argument_1);
                    207:        liberation(s_etat_processus, s_objet_argument_2);
                    208: 
                    209:        (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
                    210:        return;
                    211:    }
                    212: 
                    213:    liberation(s_etat_processus, s_objet_argument_1);
                    214:    liberation(s_etat_processus, s_objet_argument_2);
                    215: 
                    216:    if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
                    217:            s_objet_resultat) == d_erreur)
                    218:    {
                    219:        return;
                    220:    }
                    221: 
                    222:    return;
                    223: }
                    224: 
                    225: // vim: ts=4

CVSweb interface <joel.bertrand@systella.fr>