1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.36
4: Copyright (C) 1989-2025 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_resultat_intermediaire);
180: liberation(s_etat_processus, s_objet_argument_1);
181: liberation(s_etat_processus, s_objet_argument_2);
182: liberation(s_etat_processus, s_objet_resultat);
183:
184: (*s_etat_processus).erreur_execution =
185: d_ex_erreur_type_argument;
186: return;
187: }
188:
189: difference = (*(((integer8 *) (*s_objet_resultat_intermediaire)
190: .objet)) == 0) ? d_vrai : d_faux;
191:
192: liberation(s_etat_processus, s_objet_resultat_intermediaire);
193: l_element_courant = (*l_element_courant).suivant;
194: }
195:
196: if (difference == d_vrai)
197: {
198: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
199: }
200: else
201: {
202: (*((integer8 *) (*s_objet_resultat).objet)) = -1;
203: }
204: }
205: else
206: {
207: liberation(s_etat_processus, s_objet_argument_1);
208: liberation(s_etat_processus, s_objet_argument_2);
209:
210: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
211: return;
212: }
213:
214: liberation(s_etat_processus, s_objet_argument_1);
215: liberation(s_etat_processus, s_objet_argument_2);
216:
217: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
218: s_objet_resultat) == d_erreur)
219: {
220: return;
221: }
222:
223: return;
224: }
225:
226:
227: /*
228: ================================================================================
229: Fonction 'implicit'
230: ================================================================================
231: Entrées :
232: --------------------------------------------------------------------------------
233: Sorties :
234: --------------------------------------------------------------------------------
235: Effets de bord : néant
236: ================================================================================
237: */
238:
239: void
240: instruction_implicit(struct_processus *s_etat_processus)
241: {
242: struct_objet *s_objet_argument;
243:
244: unsigned char *commande;
245:
246: (*s_etat_processus).erreur_execution = d_ex;
247:
248: if ((*s_etat_processus).affichage_arguments == 'Y')
249: {
250: printf("\n IMPLICIT ");
251:
252: if ((*s_etat_processus).langue == 'F')
253: {
254: printf("(gestion des noms implicites)\n\n");
255: }
256: else
257: {
258: printf("(implicit names management)\n\n");
259: }
260:
261: printf(" 1: %s\n\n", d_CHN);
262:
263: if ((*s_etat_processus).langue == 'F')
264: {
265: printf(" Utilisation :\n\n");
266: }
267: else
268: {
269: printf(" Usage:\n\n");
270: }
271:
272: printf(" \"NONE\" IMPLICIT\n");
273: printf(" \"ALL\" IMPLICIT\n");
274: return;
275: }
276: else if ((*s_etat_processus).test_instruction == 'Y')
277: {
278: (*s_etat_processus).nombre_arguments = -1;
279: return;
280: }
281:
282: if (test_cfsf(s_etat_processus, 31) == d_vrai)
283: {
284: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
285: {
286: return;
287: }
288: }
289:
290: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
291: &s_objet_argument) == d_erreur)
292: {
293: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
294: return;
295: }
296:
297: if ((*s_objet_argument).type == CHN)
298: {
299: if ((commande = conversion_majuscule(s_etat_processus, (unsigned char *)
300: (*s_objet_argument).objet)) == NULL)
301: {
302: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
303: return;
304: }
305:
306: if (strcmp(commande, "NONE") == 0)
307: {
308: (*s_etat_processus).autorisation_nom_implicite = 'N';
309: }
310: else if (strcmp(commande, "ALL") == 0)
311: {
312: (*s_etat_processus).autorisation_nom_implicite = 'Y';
313: }
314: else
315: {
316: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
317: }
318:
319: free(commande);
320: }
321: else
322: {
323: liberation(s_etat_processus, s_objet_argument);
324:
325: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
326: return;
327: }
328:
329: liberation(s_etat_processus, s_objet_argument);
330: return;
331: }
332:
333:
334: /*
335: ================================================================================
336: Fonction 'infinity'
337: ================================================================================
338: Entrées :
339: --------------------------------------------------------------------------------
340: Sorties :
341: --------------------------------------------------------------------------------
342: Effets de bord : néant
343: ================================================================================
344: */
345:
346: void
347: instruction_sensible_infinity(struct_processus *s_etat_processus)
348: {
349: (*s_etat_processus).instruction_sensible = 'Y';
350:
351: if (strcmp((*s_etat_processus).instruction_courante, "infinity") == 0)
352: {
353: instruction_infinity(s_etat_processus);
354: }
355: else
356: {
357: (*s_etat_processus).instruction_valide = 'N';
358: }
359:
360: return;
361: }
362:
363: void
364: instruction_infinity(struct_processus *s_etat_processus)
365: {
366: struct_objet *s_objet;
367:
368: if ((*s_etat_processus).affichage_arguments == 'Y')
369: {
370: printf("\n infinity ");
371:
372: if ((*s_etat_processus).langue == 'F')
373: {
374: printf("(infini)\n\n");
375: }
376: else
377: {
378: printf("(infinity constant)\n\n");
379: }
380:
381: printf("-> 1: %s\n", d_REL);
382:
383: return;
384: }
385: else if ((*s_etat_processus).test_instruction == 'Y')
386: {
387: (*s_etat_processus).constante_symbolique = 'Y';
388: (*s_etat_processus).nombre_arguments = -1;
389: return;
390: }
391:
392: /* Indicateur 35 armé => évaluation symbolique */
393: if (test_cfsf(s_etat_processus, 35) == d_vrai)
394: {
395: if ((s_objet = allocation(s_etat_processus, NOM)) == NULL)
396: {
397: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
398: return;
399: }
400:
401: if (((*((struct_nom *) (*s_objet).objet)).nom =
402: malloc(9 * sizeof(unsigned char))) == NULL)
403: {
404: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
405: return;
406: }
407:
408: strcpy((*((struct_nom *) (*s_objet).objet)).nom, "infinity");
409: (*((struct_nom *) (*s_objet).objet)).symbole = d_faux;
410: }
411: else
412: {
413: if ((s_objet = allocation(s_etat_processus, REL)) == NULL)
414: {
415: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
416: return;
417: }
418:
419: # ifdef FP_INFINITE
420: (*((real8 *) (*s_objet).objet)) = (double) INFINITY;
421: # else
422: (*((real8 *) (*s_objet).objet)) = HUGE_VAL;
423: # endif
424: }
425:
426: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
427: s_objet) == d_erreur)
428: {
429: return;
430: }
431:
432: return;
433: }
434:
435: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_i4.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src