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