File:  [local] / rpl / src / instructions_i4.c
Revision 1.3: download - view: text, annotated - select for diffs - revision graph
Wed Feb 10 10:14:22 2010 UTC (14 years, 2 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_0_11, HEAD
Branchement vers 4.0.11

    1: /*
    2: ================================================================================
    3:   RPL/2 (R) version 4.0.11
    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>