Annotation of rpl/src/instructions_o2.c, revision 1.68
1.1 bertrand 1: /*
2: ================================================================================
1.67 bertrand 3: RPL/2 (R) version 4.1.32
1.68 ! bertrand 4: Copyright (C) 1989-2020 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.13 bertrand 23: #include "rpl-conv.h"
1.1 bertrand 24:
25:
26: /*
27: ================================================================================
28: Fonction 'obsub'
29: ================================================================================
30: Entrées :
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_obsub(struct_processus *s_etat_processus)
40: {
41: integer8 position;
42:
43: struct_liste_chainee *l_element_courant;
44:
45: struct_objet *s_copie_argument_3;
46: struct_objet *s_objet_argument_1;
47: struct_objet *s_objet_argument_2;
48: struct_objet *s_objet_argument_3;
49:
50: unsigned char *registre_definitions_chainees;
51: unsigned char *registre_instruction_courante;
52:
1.44 bertrand 53: integer8 position_courante;
1.1 bertrand 54:
55: (*s_etat_processus).erreur_execution = d_ex;
56:
57: if ((*s_etat_processus).affichage_arguments == 'Y')
58: {
59: printf("\n OBSUB ");
60:
61: if ((*s_etat_processus).langue == 'F')
62: {
63: printf("(substitution d'objet)\n\n");
64: }
65: else
66: {
67: printf("(objet substitution)\n\n");
68: }
69:
70: printf(" 3: %s\n", d_RPN);
71: printf(" 2: %s\n", d_INT);
72: printf(" 1: %s\n", d_LST);
73: printf("-> 1: %s\n\n", d_RPN);
74:
75: if ((*s_etat_processus).langue == 'F')
76: {
77: printf(" Utilisation :\n\n");
78: }
79: else
80: {
81: printf(" Usage:\n\n");
82: }
83:
84: printf(" << 1 4 + >> 3 { * } OBSUB\n");
85: printf(" << << X >> EVAL SIN >> 2 { << X 1 + >> } OBSUB\n");
86:
87: return;
88: }
89: else if ((*s_etat_processus).test_instruction == 'Y')
90: {
1.8 bertrand 91: (*s_etat_processus).nombre_arguments = -1;
1.1 bertrand 92: return;
93: }
94:
95: if (test_cfsf(s_etat_processus, 31) == d_vrai)
96: {
97: if (empilement_pile_last(s_etat_processus, 3) == d_erreur)
98: {
99: return;
100: }
101: }
102:
103: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
104: &s_objet_argument_1) == d_erreur)
105: {
106: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
107: return;
108: }
109:
110: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
111: &s_objet_argument_2) == d_erreur)
112: {
113: liberation(s_etat_processus, s_objet_argument_1);
114:
115: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
116: return;
117: }
118:
119: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
120: &s_objet_argument_3) == d_erreur)
121: {
122: liberation(s_etat_processus, s_objet_argument_1);
123: liberation(s_etat_processus, s_objet_argument_2);
124:
125: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
126: return;
127: }
128:
129: if (((*s_objet_argument_1).type == LST) &&
130: ((*s_objet_argument_2).type == INT) &&
131: ((*s_objet_argument_3).type == RPN))
132: {
133: if ((s_copie_argument_3 = copie_objet(s_etat_processus,
134: s_objet_argument_3, 'N')) == NULL)
135: {
136: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
137: return;
138: }
139:
140: liberation(s_etat_processus, s_objet_argument_3);
141: s_objet_argument_3 = s_copie_argument_3;
142:
143: position = 0;
144: l_element_courant = (*s_objet_argument_1).objet;
145:
146: while(l_element_courant != NULL)
147: {
148: position++;
149: l_element_courant = (*l_element_courant).suivant;
150: }
151:
152: if (position != 1)
153: {
154: liberation(s_etat_processus, s_objet_argument_1);
155: liberation(s_etat_processus, s_objet_argument_2);
156: liberation(s_etat_processus, s_objet_argument_3);
157:
158: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
159: return;
160: }
161:
162: if ((*((integer8 *) (*s_objet_argument_2).objet)) <= 0)
163: {
164: liberation(s_etat_processus, s_objet_argument_1);
165: liberation(s_etat_processus, s_objet_argument_2);
166: liberation(s_etat_processus, s_objet_argument_3);
167:
168: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
169: return;
170: }
171:
172: l_element_courant = (*s_objet_argument_3).objet;
173: position = 1;
174:
175: while(l_element_courant != NULL)
176: {
177: if (position == (*((integer8 *) (*s_objet_argument_2).objet)))
178: {
179: /*
180: * Substitution
181: */
182:
183: liberation(s_etat_processus, (*l_element_courant).donnee);
184:
185: if (((*l_element_courant).donnee =
186: copie_objet(s_etat_processus,
187: (*((struct_liste_chainee *)
188: (*s_objet_argument_1).objet)).donnee, 'O')) == NULL)
189: {
190: (*s_etat_processus).erreur_systeme =
191: d_es_allocation_memoire;
192: return;
193: }
194:
195: /*
196: * Analyse de l'objet résultant de la substitution
197: */
198:
199: position_courante = (*s_etat_processus).position_courante;
200: registre_definitions_chainees = (*s_etat_processus)
201: .definitions_chainees;
202: registre_instruction_courante = (*s_etat_processus)
203: .instruction_courante;
204:
205: if (((*s_etat_processus).definitions_chainees =
206: formateur(s_etat_processus, 0, s_objet_argument_3))
207: == NULL)
208: {
209: (*s_etat_processus).erreur_systeme =
210: d_es_allocation_memoire;
211: return;
212: }
213:
214: if (analyse_syntaxique(s_etat_processus) == d_erreur)
215: {
216: free((*s_etat_processus).definitions_chainees);
217:
218: (*s_etat_processus).definitions_chainees =
219: registre_definitions_chainees;
220: (*s_etat_processus).instruction_courante =
221: registre_instruction_courante;
222: (*s_etat_processus).position_courante =
223: position_courante;
224:
225: liberation(s_etat_processus, s_objet_argument_1);
226: liberation(s_etat_processus, s_objet_argument_2);
227: liberation(s_etat_processus, s_objet_argument_3);
228:
229: (*s_etat_processus).erreur_execution =
230: d_ex_argument_invalide;
231: return;
232: }
233:
234: free((*s_etat_processus).definitions_chainees);
235:
236: (*s_etat_processus).definitions_chainees =
237: registre_definitions_chainees;
238: (*s_etat_processus).instruction_courante =
239: registre_instruction_courante;
240: (*s_etat_processus).position_courante =
241: position_courante;
242:
243: break;
244: }
245:
246: position++;
247: l_element_courant = (*l_element_courant).suivant;
248: }
249:
250: if (l_element_courant == NULL)
251: {
252: liberation(s_etat_processus, s_objet_argument_1);
253: liberation(s_etat_processus, s_objet_argument_2);
254: liberation(s_etat_processus, s_objet_argument_3);
255:
256: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
257: return;
258: }
259: }
260: else
261: {
262: liberation(s_etat_processus, s_objet_argument_1);
263: liberation(s_etat_processus, s_objet_argument_2);
264: liberation(s_etat_processus, s_objet_argument_3);
265:
266: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
267: return;
268: }
269:
270: liberation(s_etat_processus, s_objet_argument_1);
271: liberation(s_etat_processus, s_objet_argument_2);
272:
273: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
274: s_objet_argument_3) == d_erreur)
275: {
276: return;
277: }
278:
279: return;
280: }
281:
282:
283: /*
284: ================================================================================
285: Fonction 'obget'
286: ================================================================================
287: Entrées :
288: --------------------------------------------------------------------------------
289: Sorties :
290: --------------------------------------------------------------------------------
291: Effets de bord : néant
292: ================================================================================
293: */
294:
295: void
296: instruction_obget(struct_processus *s_etat_processus)
297: {
298: struct_liste_chainee *l_element_courant;
299:
300: struct_objet *s_objet_argument_1;
301: struct_objet *s_objet_argument_2;
302: struct_objet *s_objet_resultat;
303:
1.44 bertrand 304: integer8 position;
1.1 bertrand 305:
306: (*s_etat_processus).erreur_execution = d_ex;
307:
308: if ((*s_etat_processus).affichage_arguments == 'Y')
309: {
310: printf("\n OBGET ");
311:
312: if ((*s_etat_processus).langue == 'F')
313: {
314: printf("(extraction d'un objet)\n\n");
315: }
316: else
317: {
318: printf("(get objet)\n\n");
319: }
320:
321: printf(" 2: %s\n", d_RPN);
322: printf(" 1: %s\n", d_INT);
323: printf("-> 1: %s\n", d_LST);
324:
325: return;
326: }
327: else if ((*s_etat_processus).test_instruction == 'Y')
328: {
1.8 bertrand 329: (*s_etat_processus).nombre_arguments = -1;
1.1 bertrand 330: return;
331: }
332:
333: if (test_cfsf(s_etat_processus, 31) == d_vrai)
334: {
335: if (empilement_pile_last(s_etat_processus, 2) == d_erreur)
336: {
337: return;
338: }
339: }
340:
341: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
342: &s_objet_argument_1) == d_erreur)
343: {
344: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
345: return;
346: }
347:
348: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
349: &s_objet_argument_2) == d_erreur)
350: {
351: liberation(s_etat_processus, s_objet_argument_1);
352:
353: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
354: return;
355: }
356:
357: if (((*s_objet_argument_1).type == INT) &&
358: ((*s_objet_argument_2).type == RPN))
359: {
360: if ((*((integer8 *) (*s_objet_argument_1).objet)) <= 0)
361: {
362: liberation(s_etat_processus, s_objet_argument_1);
363: liberation(s_etat_processus, s_objet_argument_2);
364:
365: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
366: return;
367: }
368:
369: l_element_courant = (*s_objet_argument_2).objet;
370: position = 1;
371:
372: while(l_element_courant != NULL)
373: {
1.44 bertrand 374: if (position == (*((integer8 *) (*s_objet_argument_1).objet)))
1.1 bertrand 375: {
376: /*
377: * Récupération de l'objet
378: */
379:
380: if ((s_objet_resultat = allocation(s_etat_processus, LST))
381: == NULL)
382: {
383: (*s_etat_processus).erreur_systeme =
384: d_es_allocation_memoire;
385: return;
386: }
387:
388: if (((*s_objet_resultat).objet =
389: allocation_maillon(s_etat_processus)) == NULL)
390: {
391: (*s_etat_processus).erreur_systeme =
392: d_es_allocation_memoire;
393: return;
394: }
395:
396: (*((struct_liste_chainee *) (*s_objet_resultat).objet))
397: .suivant = NULL;
398:
399: if (((*((struct_liste_chainee *) (*s_objet_resultat).objet))
400: .donnee = copie_objet(s_etat_processus,
401: (*l_element_courant).donnee, 'O')) == NULL)
402: {
403: (*s_etat_processus).erreur_systeme =
404: d_es_allocation_memoire;
405: return;
406: }
407:
408: break;
409: }
410:
411: position++;
412: l_element_courant = (*l_element_courant).suivant;
413: }
414:
415: if (l_element_courant == NULL)
416: {
417: liberation(s_etat_processus, s_objet_argument_1);
418: liberation(s_etat_processus, s_objet_argument_2);
419:
420: (*s_etat_processus).erreur_execution = d_ex_element_inexistant;
421: return;
422: }
423:
424: /*
425: * Vérification de la cohérence de l'élément. Nous ne devons avoir
426: * ni '<<' ni '>>'.
427: */
428:
429: if ((*(*((struct_liste_chainee *) (*s_objet_resultat).objet))
430: .donnee).type == FCT)
431: {
432: if ((strcmp((*((struct_fonction *) (*(*((struct_liste_chainee *)
433: (*s_objet_resultat).objet)).donnee).objet)).nom_fonction,
434: "<<") == 0) || (strcmp((*((struct_fonction *)
435: (*(*((struct_liste_chainee *) (*s_objet_resultat).objet))
436: .donnee).objet)).nom_fonction, ">>") == 0))
437: {
438: liberation(s_etat_processus, s_objet_argument_1);
439: liberation(s_etat_processus, s_objet_argument_2);
440: liberation(s_etat_processus, s_objet_resultat);
441:
442: (*s_etat_processus).erreur_execution = d_ex_argument_invalide;
443: return;
444: }
445: }
446: }
447: else
448: {
449: liberation(s_etat_processus, s_objet_argument_1);
450: liberation(s_etat_processus, s_objet_argument_2);
451:
452: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
453: return;
454: }
455:
456: liberation(s_etat_processus, s_objet_argument_1);
457: liberation(s_etat_processus, s_objet_argument_2);
458:
459: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
460: s_objet_resultat) == d_erreur)
461: {
462: return;
463: }
464:
465: return;
466: }
467:
468: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_o2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src