Annotation of rpl/src/instructions_e2.c, revision 1.76
1.1 bertrand 1: /*
2: ================================================================================
1.75 bertrand 3: RPL/2 (R) version 4.1.32
1.76 ! 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 'egvl'
29: ================================================================================
30: Entrées : pointeur sur une structure struct_processus
31: --------------------------------------------------------------------------------
32: Sorties :
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: void
39: instruction_egvl(struct_processus *s_etat_processus)
40: {
41: struct_objet *s_objet_argument;
42: struct_objet *s_objet_resultat;
43:
44: (*s_etat_processus).erreur_execution = d_ex;
45:
46: if ((*s_etat_processus).affichage_arguments == 'Y')
47: {
48: printf("\n EGVL ");
49:
50: if ((*s_etat_processus).langue == 'F')
51: {
52: printf("(valeurs propres)\n\n");
53: }
54: else
55: {
56: printf("(eigenvalues)\n\n");
57: }
58:
59: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
60: printf("-> 1: %s\n", d_VCX);
61:
62: return;
63: }
64: else if ((*s_etat_processus).test_instruction == 'Y')
65: {
66: (*s_etat_processus).nombre_arguments = -1;
67: return;
68: }
69:
70: if (test_cfsf(s_etat_processus, 31) == d_vrai)
71: {
72: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
73: {
74: return;
75: }
76: }
77:
78: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
79: &s_objet_argument) == d_erreur)
80: {
81: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
82: return;
83: }
84:
85: /*
86: --------------------------------------------------------------------------------
87: L'argument est une matrice carrée
88: --------------------------------------------------------------------------------
89: */
90:
91: if (((*s_objet_argument).type == MIN) ||
92: ((*s_objet_argument).type == MRL) ||
93: ((*s_objet_argument).type == MCX))
94: {
95: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
96: (*((struct_matrice *) (*s_objet_argument).objet))
97: .nombre_colonnes)
98: {
99: liberation(s_etat_processus, s_objet_argument);
100:
101: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
102: return;
103: }
104:
105: if ((s_objet_resultat = allocation(s_etat_processus, VCX))
106: == NULL)
107: {
108: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
109: return;
110: }
111:
112: valeurs_propres(s_etat_processus,
113: (struct_matrice *) (*s_objet_argument).objet,
114: (struct_vecteur *) (*s_objet_resultat).objet,
115: NULL, NULL);
116:
117: if ((*s_etat_processus).erreur_systeme != d_es)
118: {
119: return;
120: }
121:
122: if (((*s_etat_processus).exception != d_ep) ||
123: ((*s_etat_processus).erreur_execution != d_ex))
124: {
125: liberation(s_etat_processus, s_objet_argument);
126: liberation(s_etat_processus, s_objet_resultat);
127: return;
128: }
129: }
130:
131: /*
132: --------------------------------------------------------------------------------
133: Type incompatible
134: --------------------------------------------------------------------------------
135: */
136:
137: else
138: {
139: liberation(s_etat_processus, s_objet_argument);
140:
141: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
142: return;
143: }
144:
145: liberation(s_etat_processus, s_objet_argument);
146:
147: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
148: s_objet_resultat) == d_erreur)
149: {
150: return;
151: }
152:
153: return;
154: }
155:
156:
157: /*
158: ================================================================================
159: Fonction 'egv'
160: ================================================================================
161: Entrées : pointeur sur une structure struct_processus
162: --------------------------------------------------------------------------------
163: Sorties :
164: --------------------------------------------------------------------------------
165: Effets de bord : néant
166: ================================================================================
167: */
168:
169: void
170: instruction_egv(struct_processus *s_etat_processus)
171: {
172: struct_objet *s_objet_argument;
173: struct_objet *s_objet_resultat_1;
174: struct_objet *s_objet_resultat_2;
175: struct_objet *s_objet_resultat_3;
176:
177: (*s_etat_processus).erreur_execution = d_ex;
178:
179: if ((*s_etat_processus).affichage_arguments == 'Y')
180: {
181: printf("\n EGV ");
182:
183: if ((*s_etat_processus).langue == 'F')
184: {
185: printf("(valeurs et vecteurs propres)\n\n");
186: }
187: else
188: {
189: printf("(eigenvalues and eigenvectors)\n\n");
190: }
191:
192: printf(" 1: %s, %s, %s\n", d_MIN, d_MRL, d_MCX);
193: printf("-> 3: %s\n", d_MCX);
194: printf(" 2: %s\n", d_MCX);
195: printf(" 1: %s\n", d_VCX);
196:
197: return;
198: }
199: else if ((*s_etat_processus).test_instruction == 'Y')
200: {
201: (*s_etat_processus).nombre_arguments = -1;
202: return;
203: }
204:
205: if (test_cfsf(s_etat_processus, 31) == d_vrai)
206: {
207: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
208: {
209: return;
210: }
211: }
212:
213: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
214: &s_objet_argument) == d_erreur)
215: {
216: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
217: return;
218: }
219:
220: /*
221: --------------------------------------------------------------------------------
222: L'argument est une matrice carrée
223: --------------------------------------------------------------------------------
224: */
225:
226: if (((*s_objet_argument).type == MIN) ||
227: ((*s_objet_argument).type == MRL) ||
228: ((*s_objet_argument).type == MCX))
229: {
230: if ((*((struct_matrice *) (*s_objet_argument).objet)).nombre_lignes !=
231: (*((struct_matrice *) (*s_objet_argument).objet))
232: .nombre_colonnes)
233: {
234: liberation(s_etat_processus, s_objet_argument);
235:
236: (*s_etat_processus).erreur_execution = d_ex_dimensions_invalides;
237: return;
238: }
239:
240: if ((s_objet_resultat_1 = allocation(s_etat_processus, VCX))
241: == NULL)
242: {
243: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
244: return;
245: }
246:
247: if ((s_objet_resultat_2 = allocation(s_etat_processus, MCX))
248: == NULL)
249: {
250: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
251: return;
252: }
253:
254: if ((s_objet_resultat_3 = allocation(s_etat_processus, MCX))
255: == NULL)
256: {
257: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
258: return;
259: }
260:
261: valeurs_propres(s_etat_processus,
262: (struct_matrice *) (*s_objet_argument).objet,
263: (struct_vecteur *) (*s_objet_resultat_1).objet,
264: (struct_matrice *) (*s_objet_resultat_3).objet,
265: (struct_matrice *) (*s_objet_resultat_2).objet);
266:
267: if ((*s_etat_processus).erreur_systeme != d_es)
268: {
269: return;
270: }
271:
272: if (((*s_etat_processus).exception != d_ep) ||
273: ((*s_etat_processus).erreur_execution != d_ex))
274: {
275: liberation(s_etat_processus, s_objet_argument);
276: liberation(s_etat_processus, s_objet_resultat_1);
277: liberation(s_etat_processus, s_objet_resultat_2);
278: liberation(s_etat_processus, s_objet_resultat_3);
279: return;
280: }
281: }
282:
283: /*
284: --------------------------------------------------------------------------------
285: Type incompatible
286: --------------------------------------------------------------------------------
287: */
288:
289: else
290: {
291: liberation(s_etat_processus, s_objet_argument);
292:
293: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
294: return;
295: }
296:
297: liberation(s_etat_processus, s_objet_argument);
298:
299: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
300: s_objet_resultat_3) == d_erreur)
301: {
302: return;
303: }
304:
305: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
306: s_objet_resultat_2) == d_erreur)
307: {
308: return;
309: }
310:
311: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
312: s_objet_resultat_1) == d_erreur)
313: {
314: return;
315: }
316:
317: return;
318: }
319:
320:
321: /*
322: ================================================================================
323: Fonction 'erase' (detruit la queue d'impression)
324: ================================================================================
325: Entrées : structure processus
326: --------------------------------------------------------------------------------
327: Sorties :
328: --------------------------------------------------------------------------------
329: Effets de bord : néant
330: ================================================================================
331: */
332:
333: void
334: instruction_erase(struct_processus *s_etat_processus)
335: {
336: (*s_etat_processus).erreur_execution = d_ex;
337:
338: if ((*s_etat_processus).affichage_arguments == 'Y')
339: {
340: printf("\n ERASE ");
341:
342: if ((*s_etat_processus).langue == 'F')
343: {
344: printf("(efface la file d'impression)\n\n");
345: printf(" Aucun argument\n");
346: }
347: else
348: {
349: printf("(erase the printer queue)\n\n");
350: printf(" No argument\n");
351: }
352:
353: return;
354: }
355: else if ((*s_etat_processus).test_instruction == 'Y')
356: {
357: (*s_etat_processus).nombre_arguments = -1;
358: return;
359: }
360:
361: if (test_cfsf(s_etat_processus, 31) == d_vrai)
362: {
363: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
364: {
365: return;
366: }
367: }
368:
369: if ((*s_etat_processus).nom_fichier_impression != NULL)
370: {
371: if (destruction_fichier((*s_etat_processus).nom_fichier_impression)
372: == d_erreur)
373: {
374: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
375: return;
376: }
377:
378: free((*s_etat_processus).nom_fichier_impression);
379: (*s_etat_processus).nom_fichier_impression = NULL;
380: }
381:
382: return;
383: }
384:
385:
386: /*
387: ================================================================================
388: Fonction 'epsilon' (renvoie la le plus petit réel e tel x + e != x)
389: ================================================================================
390: Entrées : structure processus
391: --------------------------------------------------------------------------------
392: Sorties :
393: --------------------------------------------------------------------------------
394: Effets de bord : néant
395: ================================================================================
396: */
397:
398: void
399: instruction_epsilon(struct_processus *s_etat_processus)
400: {
401: struct_objet *s_copie;
402: struct_objet *s_objet;
403:
404: (*s_etat_processus).erreur_execution = d_ex;
405:
406: if ((*s_etat_processus).affichage_arguments == 'Y')
407: {
408: printf("\n EPSILON ");
409:
410: if ((*s_etat_processus).langue == 'F')
411: {
412: printf("(epsilon machine)\n\n");
413: }
414: else
415: {
416: printf("(computer epsilon)\n\n");
417: }
418:
419: printf(" 1: %s\n", d_INT);
420: printf("-> 1: %s\n\n", d_INT);
421:
422: printf(" 1: %s\n", d_CPL);
423: printf("-> 1: %s\n\n", d_CPL);
424:
425: printf(" 1: %s\n", d_REL);
426: printf("-> 1: %s\n", d_REL);
427:
428: return;
429: }
430: else if ((*s_etat_processus).test_instruction == 'Y')
431: {
432: (*s_etat_processus).nombre_arguments = 1;
433: return;
434: }
435:
436: if (test_cfsf(s_etat_processus, 31) == d_vrai)
437: {
438: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
439: {
440: return;
441: }
442: }
443:
444: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
445: &s_objet) == d_erreur)
446: {
447: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
448: return;
449: }
450:
451: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
452: {
453: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
454: return;
455: }
456:
457: liberation(s_etat_processus, s_objet);
458: s_objet = s_copie;
459:
460: /*
461: * L'argument est un entier et la routine renvoie 1.
462: */
463:
464: if ((*s_objet).type == INT)
465: {
466: (*((integer8 *) (*s_objet).objet)) = 1;
467: }
468:
469: /*
470: * L'argument est un réel
471: */
472:
473: else if ((*s_objet).type == REL)
474: {
475: if ((*((real8 *) (*s_objet).objet)) == 0)
476: {
477: (*((real8 *) (*s_objet).objet)) = nextafter((double) 0, (double) 1);
478: }
479: else
480: {
481: (*((real8 *) (*s_objet).objet)) = nextafter(-abs(*((real8 *)
482: (*s_objet).objet)), 0) + abs(*((real8 *) (*s_objet).objet));
483: }
484: }
485:
486: /*
487: * L'argument est un complexe
488: */
489:
490: else if ((*s_objet).type == CPL)
491: {
492: (*((complex16 *) (*s_objet).objet)).partie_reelle =
493: nextafter(-abs((*((complex16 *) (*s_objet).objet))
494: .partie_reelle), 0) + abs((*((complex16 *) (*s_objet).objet))
495: .partie_reelle);
496: (*((complex16 *) (*s_objet).objet)).partie_imaginaire =
497: nextafter(-abs((*((complex16 *) (*s_objet).objet))
498: .partie_imaginaire), 0) + abs((*((complex16 *)
499: (*s_objet).objet)).partie_imaginaire);
500: }
501: else
502: {
503: liberation(s_etat_processus, s_objet);
504:
505: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
506: return;
507: }
508:
509: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
510: s_objet) == d_erreur)
511: {
512: return;
513: }
514:
515: return;
516: }
517:
518:
519: /*
520: ================================================================================
521: Fonction 'errn' (detruit la queue d'impression)
522: ================================================================================
523: Entrées : structure processus
524: --------------------------------------------------------------------------------
525: Sorties :
526: --------------------------------------------------------------------------------
527: Effets de bord : néant
528: ================================================================================
529: */
530:
531: void
532: instruction_errn(struct_processus *s_etat_processus)
533: {
534: struct_objet *s_objet_resultat;
535:
536: (*s_etat_processus).erreur_execution = d_ex;
537:
538: if ((*s_etat_processus).affichage_arguments == 'Y')
539: {
540: printf("\n ERRN ");
541:
542: if ((*s_etat_processus).langue == 'F')
543: {
544: printf("(numéro de la dernière erreur)\n\n");
545: }
546: else
547: {
548: printf("(last error number)\n\n");
549: }
550:
551: printf("-> 1: %s\n", d_INT);
552:
553: return;
554: }
555: else if ((*s_etat_processus).test_instruction == 'Y')
556: {
557: (*s_etat_processus).nombre_arguments = -1;
558: return;
559: }
560:
561: if (test_cfsf(s_etat_processus, 31) == d_vrai)
562: {
563: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
564: {
565: return;
566: }
567: }
568:
569: if ((s_objet_resultat = allocation(s_etat_processus, INT)) == NULL)
570: {
571: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
572: return;
573: }
574:
575: if ((*s_etat_processus).derniere_exception != d_ep)
576: {
577: (*((integer8 *) (*s_objet_resultat).objet)) =
578: 1000 + ((*s_etat_processus).derniere_exception - d_ep);
579: }
580: else if ((*s_etat_processus).derniere_erreur_execution != d_ex)
581: {
582: (*((integer8 *) (*s_objet_resultat).objet)) =
583: 0 + ((*s_etat_processus).derniere_erreur_execution - d_ex);
584: }
585: else if ((*s_etat_processus).derniere_erreur_systeme != d_es)
586: {
587: /*
588: * On ne doit jamais passer par ici !
589: */
590:
591: (*((integer8 *) (*s_objet_resultat).objet)) =
592: 2000 + ((*s_etat_processus).derniere_erreur_systeme - d_es);
593: }
594: else
595: {
596: (*((integer8 *) (*s_objet_resultat).objet)) = 0;
597: }
598:
599: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
600: s_objet_resultat) == d_erreur)
601: {
602: return;
603: }
604:
605: return;
606: }
607:
608:
609: /*
610: ================================================================================
611: Fonction 'errm'
612: ================================================================================
613: Entrées : structure processus
614: --------------------------------------------------------------------------------
615: Sorties :
616: --------------------------------------------------------------------------------
617: Effets de bord : néant
618: ================================================================================
619: */
620:
621: void
622: instruction_errm(struct_processus *s_etat_processus)
623: {
624: struct_objet *s_objet_resultat;
625:
1.48 bertrand 626: int registre_erreur_execution;
627: int registre_erreur_systeme;
628: int registre_exception;
1.1 bertrand 629:
630: (*s_etat_processus).erreur_execution = d_ex;
631:
632: if ((*s_etat_processus).affichage_arguments == 'Y')
633: {
634: printf("\n ERRM ");
635:
636: if ((*s_etat_processus).langue == 'F')
637: {
638: printf("(dernier message d'erreur)\n\n");
639: }
640: else
641: {
642: printf("(last error message)\n\n");
643: }
644:
645: printf("-> 1: %s\n", d_CHN);
646:
647: return;
648: }
649: else if ((*s_etat_processus).test_instruction == 'Y')
650: {
651: (*s_etat_processus).nombre_arguments = -1;
652: return;
653: }
654:
655: if (test_cfsf(s_etat_processus, 31) == d_vrai)
656: {
657: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
658: {
659: return;
660: }
661: }
662:
663: if ((s_objet_resultat = allocation(s_etat_processus, CHN)) == NULL)
664: {
665: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
666: return;
667: }
668:
669: registre_exception = (*s_etat_processus).exception;
670: registre_erreur_execution = (*s_etat_processus).erreur_execution;
671: registre_erreur_systeme = (*s_etat_processus).erreur_systeme;
672:
673: (*s_etat_processus).exception =
674: (*s_etat_processus).derniere_exception;
675: (*s_etat_processus).erreur_execution =
676: (*s_etat_processus).derniere_erreur_execution;
677: (*s_etat_processus).erreur_systeme =
678: (*s_etat_processus).derniere_erreur_systeme;
679:
680: if (((*s_objet_resultat).objet =
681: messages(s_etat_processus)) == NULL)
682: {
683: (*s_etat_processus).exception =
684: registre_exception;
685: (*s_etat_processus).erreur_execution =
686: registre_erreur_execution;
687: (*s_etat_processus).erreur_systeme =
688: registre_erreur_systeme;
689:
690: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
691: return;
692: }
693:
694: (*s_etat_processus).exception = registre_exception;
695: (*s_etat_processus).erreur_execution = registre_erreur_execution;
696: (*s_etat_processus).erreur_systeme = registre_erreur_systeme;
697:
698: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
699: s_objet_resultat) == d_erreur)
700: {
701: return;
702: }
703:
704: return;
705: }
706:
707:
708: /*
709: ================================================================================
710: Fonction 'edit'
711: ================================================================================
712: Entrées : structure processus
713: --------------------------------------------------------------------------------
714: Sorties :
715: --------------------------------------------------------------------------------
716: Effets de bord : néant
717: ================================================================================
718: */
719:
720: void
721: instruction_edit(struct_processus *s_etat_processus)
722: {
723: # ifdef VIM_SUPPORT
1.13 bertrand 724: # include "vim-conv.h"
1.1 bertrand 725:
726: file *fichier;
727:
728: logical1 drapeau49;
729: logical1 drapeau50;
730:
731: struct_liste_chainee *registre_pile_last;
732:
733: struct_objet *s_copie;
734: struct_objet *s_objet;
735: struct_objet *s_objet_nom;
736:
737: unsigned char *chaine;
738: unsigned char *commande;
739: unsigned char *nom_fichier;
1.3 bertrand 740: unsigned char registre;
1.1 bertrand 741:
742: (*s_etat_processus).erreur_execution = d_ex;
743:
744: if ((*s_etat_processus).affichage_arguments == 'Y')
745: {
746: printf("\n EDIT ");
747:
748: if ((*s_etat_processus).langue == 'F')
749: {
750: printf("(édition d'un objet)\n\n");
751: }
752: else
753: {
754: printf("(edit object)\n\n");
755: }
756:
757: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
758: " %s, %s, %s, %s, %s,\n"
759: " %s, %s, %s, %s, %s\n",
760: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
761: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
762: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
763: " %s, %s, %s, %s, %s,\n"
764: " %s, %s, %s, %s, %s\n",
765: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
766: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
767: printf(" ...\n");
768: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
769: " %s, %s, %s, %s, %s,\n"
770: " %s, %s, %s, %s, %s\n",
771: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
772: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
773: return;
774: }
775: else if ((*s_etat_processus).test_instruction == 'Y')
776: {
777: (*s_etat_processus).nombre_arguments = -1;
778: return;
779: }
780:
781: if (test_cfsf(s_etat_processus, 31) == d_vrai)
782: {
783: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
784: {
785: return;
786: }
787: }
788:
789: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
790: &s_objet) == d_erreur)
791: {
792: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
793: return;
794: }
795:
796: if (((*s_objet).type != INT) &&
797: ((*s_objet).type != REL) &&
798: ((*s_objet).type != CPL) &&
799: ((*s_objet).type != VIN) &&
800: ((*s_objet).type != VRL) &&
801: ((*s_objet).type != VCX) &&
802: ((*s_objet).type != MIN) &&
803: ((*s_objet).type != MRL) &&
804: ((*s_objet).type != MCX) &&
805: ((*s_objet).type != TBL) &&
806: ((*s_objet).type != BIN) &&
807: ((*s_objet).type != NOM) &&
808: ((*s_objet).type != CHN) &&
809: ((*s_objet).type != LST) &&
810: ((*s_objet).type != ALG) &&
811: ((*s_objet).type != RPN))
812: {
813: liberation(s_etat_processus, s_objet);
814:
815: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
816: return;
817: }
818:
819: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
820: {
821: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
822: return;
823: }
824:
825: liberation(s_etat_processus, s_objet);
826: s_objet = s_copie;
827:
828: // Création d'un fichier temporaire à éditer
829:
830: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
831: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
832: {
833: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
834: return;
835: }
836:
837: drapeau49 = test_cfsf(s_etat_processus, 49);
838: drapeau50 = test_cfsf(s_etat_processus, 50);
839:
840: cf(s_etat_processus, 49);
841: cf(s_etat_processus, 50);
842:
843: // Ecriture de l'objet dans le fichier en mode STD et multiligne
844:
845: if ((fichier = fopen(nom_fichier, "w+")) == NULL)
846: {
847: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
848: return;
849: }
850:
1.3 bertrand 851: registre = (*s_etat_processus).autorisation_conversion_chaine;
852: (*s_etat_processus).autorisation_conversion_chaine = 'N';
853:
1.1 bertrand 854: if ((chaine = formateur(s_etat_processus, 0, s_objet)) == NULL)
855: {
1.3 bertrand 856: (*s_etat_processus).autorisation_conversion_chaine = registre;
857:
1.1 bertrand 858: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
859: return;
860: }
861:
1.3 bertrand 862: (*s_etat_processus).autorisation_conversion_chaine = registre;
863:
1.1 bertrand 864: if ((*s_objet).type == CHN)
865: {
866: if (fprintf(fichier, "\"%s\"\n", chaine) != (int) (strlen(chaine) + 3))
867: {
868: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
869: return;
870: }
871: }
872: else
873: {
874: if (fprintf(fichier, "%s\n", chaine) != (int) (strlen(chaine) + 1))
875: {
876: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
877: return;
878: }
879: }
880:
881: free(chaine);
882:
883: if (fclose(fichier) != 0)
884: {
885: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
886: return;
887: }
888:
1.5 bertrand 889: if ((commande = malloc((strlen(ds_vim_commande) + strlen(nom_fichier)
890: - 1) * sizeof(unsigned char))) == NULL)
1.1 bertrand 891: {
1.5 bertrand 892: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
893: return;
894: }
1.1 bertrand 895:
1.5 bertrand 896: sprintf(commande, ds_vim_commande, nom_fichier);
1.1 bertrand 897:
1.5 bertrand 898: if (system(commande) != 0)
899: {
900: free(commande);
1.1 bertrand 901:
1.5 bertrand 902: (*s_etat_processus).erreur_systeme = d_es_processus;
903: return;
904: }
1.1 bertrand 905:
1.5 bertrand 906: free(commande);
1.1 bertrand 907:
1.5 bertrand 908: if ((s_objet_nom = allocation(s_etat_processus, CHN)) == NULL)
909: {
910: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
911: return;
912: }
1.1 bertrand 913:
1.5 bertrand 914: if (((*s_objet_nom).objet = malloc((strlen(nom_fichier) + 1)
915: * sizeof(unsigned char))) == NULL)
916: {
917: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
918: return;
919: }
1.1 bertrand 920:
1.5 bertrand 921: strcpy((unsigned char *) (*s_objet_nom).objet, nom_fichier);
1.1 bertrand 922:
1.5 bertrand 923: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
924: s_objet_nom) == d_erreur)
925: {
926: return;
927: }
1.1 bertrand 928:
1.5 bertrand 929: registre_pile_last = (*s_etat_processus).l_base_pile_last;
930: (*s_etat_processus).l_base_pile_last = NULL;
1.1 bertrand 931:
1.5 bertrand 932: instruction_recall(s_etat_processus);
1.1 bertrand 933:
1.5 bertrand 934: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
935: {
936: return;
937: }
1.1 bertrand 938:
1.5 bertrand 939: (*s_etat_processus).l_base_pile_last = registre_pile_last;
1.1 bertrand 940:
1.5 bertrand 941: // Destruction du fichier temporaire
1.1 bertrand 942:
1.5 bertrand 943: if (destruction_fichier(nom_fichier) == d_erreur)
944: {
945: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
946: return;
947: }
1.1 bertrand 948:
1.5 bertrand 949: free(nom_fichier);
1.1 bertrand 950:
1.5 bertrand 951: if (((*s_etat_processus).erreur_systeme != d_es) ||
952: ((*s_etat_processus).erreur_execution != d_ex) ||
953: ((*s_etat_processus).exception != d_ep))
954: {
955: liberation(s_etat_processus, s_objet);
1.1 bertrand 956:
1.5 bertrand 957: return;
958: }
1.1 bertrand 959:
1.5 bertrand 960: if ((*s_etat_processus).erreur_systeme != d_es)
961: {
962: return;
963: }
1.1 bertrand 964:
1.5 bertrand 965: if ((*s_etat_processus).erreur_execution == d_ex_fichier_vide)
966: {
967: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
968: s_objet) == d_erreur)
1.1 bertrand 969: {
1.5 bertrand 970: return;
1.1 bertrand 971: }
972:
1.5 bertrand 973: (*s_etat_processus).erreur_execution = d_ex;
974: }
975: else
1.1 bertrand 976: {
977: liberation(s_etat_processus, s_objet);
978: }
979:
980: if (drapeau49 == d_vrai)
981: {
982: sf(s_etat_processus, 49);
983: }
984: else
985: {
986: cf(s_etat_processus, 49);
987: }
988:
989: if (drapeau50 == d_vrai)
990: {
991: sf(s_etat_processus, 50);
992: }
993: else
994: {
995: cf(s_etat_processus, 50);
996: }
997:
998: # endif
999:
1000: return;
1001: }
1002:
1003:
1004: /*
1005: ================================================================================
1006: Fonction 'externals'
1007: ================================================================================
1008: Entrées : structure processus
1009: --------------------------------------------------------------------------------
1010: Sorties :
1011: --------------------------------------------------------------------------------
1012: Effets de bord : néant
1013: ================================================================================
1014: */
1015:
1016: void
1017: instruction_externals(struct_processus *s_etat_processus)
1018: {
1019: logical1 ambiguite;
1020:
1.48 bertrand 1021: integer8 i;
1.1 bertrand 1022:
1023: struct_liste_chainee *l_element_courant;
1024:
1025: struct_objet *s_objet;
1026:
1027: (*s_etat_processus).erreur_execution = d_ex;
1028:
1029: if ((*s_etat_processus).affichage_arguments == 'Y')
1030: {
1031: printf("\n EXTERNALS ");
1032:
1033: if ((*s_etat_processus).langue == 'F')
1034: {
1035: printf("(liste des définitions externes)\n\n");
1036: }
1037: else
1038: {
1039: printf("(list of external definitions)\n\n");
1040: }
1041:
1042: printf("-> 1: %s\n", d_LST);
1043: return;
1044: }
1045: else if ((*s_etat_processus).test_instruction == 'Y')
1046: {
1047: (*s_etat_processus).nombre_arguments = -1;
1048: return;
1049: }
1050:
1051: if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
1052: {
1053: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1054: return;
1055: }
1056:
1057: (*s_objet).objet = NULL;
1058:
1059: /*
1060: * { "fonction" } si la fonction n'est pas ambiguë
1061: * { "bibliotheque$fonction" } sinon.
1062: */
1063:
1064: l_element_courant = NULL;
1065:
1066: for(i = 0; i < (*s_etat_processus).nombre_instructions_externes; i++)
1067: {
1068: if (l_element_courant == NULL)
1069: {
1070: if (((*s_objet).objet = allocation_maillon(s_etat_processus))
1071: == NULL)
1072: {
1073: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1074: return;
1075: }
1076:
1077: l_element_courant = (*s_objet).objet;
1078: }
1079: else
1080: {
1081: if (((*l_element_courant).suivant =
1082: allocation_maillon(s_etat_processus)) == NULL)
1083: {
1084: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1085: return;
1086: }
1087:
1088: l_element_courant = (*l_element_courant).suivant;
1089: }
1090:
1091: (*l_element_courant).suivant = NULL;
1092:
1093: if (((*l_element_courant).donnee = allocation(s_etat_processus, CHN))
1094: == NULL)
1095: {
1096: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1097: return;
1098: }
1099:
1100: ambiguite = d_faux;
1101:
1102: if (i > 0)
1103: {
1104: if (strcmp((*s_etat_processus).s_instructions_externes[i].nom,
1105: (*s_etat_processus).s_instructions_externes[i - 1].nom)
1106: == 0)
1107: {
1108: ambiguite = d_vrai;
1109: }
1110: }
1111:
1112: if (((i + 1) < (*s_etat_processus).nombre_instructions_externes) &&
1113: (ambiguite == d_faux))
1114: {
1115: if (strcmp((*s_etat_processus).s_instructions_externes[i].nom,
1116: (*s_etat_processus).s_instructions_externes[i + 1].nom)
1117: == 0)
1118: {
1119: ambiguite = d_vrai;
1120: }
1121: }
1122:
1123: if (ambiguite == d_faux)
1124: {
1125: if (((*(*l_element_courant).donnee).objet = malloc((strlen(
1126: (*s_etat_processus).s_instructions_externes[i].nom) + 1)
1127: * sizeof(unsigned char))) == NULL)
1128: {
1129: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1130: return;
1131: }
1132:
1133: strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,
1134: (*s_etat_processus).s_instructions_externes[i].nom);
1.68 bertrand 1135:
1136: if ((*s_etat_processus).s_instructions_externes[i].position_fleche
1137: >= 0)
1138: {
1.71 bertrand 1139: memcpy((unsigned char *) (*(*l_element_courant).donnee).objet
1.68 bertrand 1140: + (*s_etat_processus).s_instructions_externes[i]
1141: .position_fleche - (strlen((*s_etat_processus)
1142: .s_instructions_externes[i].nom_bibliotheque) + 1),
1143: "->", 2);
1144: }
1.1 bertrand 1145: }
1146: else
1147: {
1148: if (((*(*l_element_courant).donnee).objet = malloc((strlen(
1149: (*s_etat_processus).s_instructions_externes[i].nom) +
1150: strlen((*s_etat_processus).s_instructions_externes[i]
1151: .nom_bibliotheque) + 2) * sizeof(unsigned char))) == NULL)
1152: {
1153: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1154: return;
1155: }
1156:
1157: sprintf((unsigned char *) (*(*l_element_courant).donnee).objet,
1158: "%s$%s", (*s_etat_processus).s_instructions_externes[i]
1159: .nom_bibliotheque, (*s_etat_processus)
1160: .s_instructions_externes[i].nom);
1.68 bertrand 1161:
1162: if ((*s_etat_processus).s_instructions_externes[i].position_fleche
1163: >= 0)
1164: {
1.71 bertrand 1165: memcpy((unsigned char *) (*(*l_element_courant).donnee).objet
1.68 bertrand 1166: + (*s_etat_processus).s_instructions_externes[i]
1167: .position_fleche, "->", 2);
1168: }
1.1 bertrand 1169: }
1170: }
1171:
1172: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1173: s_objet) == d_erreur)
1174: {
1175: return;
1176: }
1177:
1178: return;
1179: }
1180:
1181:
1182: /*
1183: ================================================================================
1184: Fonction 'exit'
1185: ================================================================================
1186: Entrées : structure processus
1187: --------------------------------------------------------------------------------
1188: Sorties :
1189: --------------------------------------------------------------------------------
1190: Effets de bord : néant
1191: ================================================================================
1192: */
1193:
1194: void
1195: instruction_exit(struct_processus *s_etat_processus)
1196: {
1197: logical1 drapeau_boucle_definie;
1198: logical1 drapeau_presence_fin_boucle;
1199: logical1 erreur;
1200: logical1 presence_boucle;
1201: logical1 presence_compteur;
1202:
1203: struct_liste_pile_systeme *l_element_pile_systeme;
1204:
1205: unsigned char *instruction_majuscule;
1206: unsigned char *tampon;
1207:
1.48 bertrand 1208: integer8 niveau;
1.1 bertrand 1209:
1210: void (*fonction)();
1211:
1212: (*s_etat_processus).erreur_execution = d_ex;
1213:
1214: if ((*s_etat_processus).affichage_arguments == 'Y')
1215: {
1216: printf("\n EXIT ");
1217:
1218: if ((*s_etat_processus).langue == 'F')
1219: {
1220: printf("(structure de contrôle)\n\n");
1221: printf(" Utilisation :\n\n");
1222: }
1223: else
1224: {
1225: printf("(control statement)\n\n");
1226: printf(" Usage:\n\n");
1227: }
1228:
1229: printf(" START/FOR\n");
1230: printf(" (expression 1)\n");
1231: printf(" EXIT\n");
1232: printf(" (expression 2)\n");
1233: printf(" NEXT/STEP\n\n");
1234:
1.39 bertrand 1235: printf(" FORALL\n");
1236: printf(" (expression 1)\n");
1237: printf(" EXIT\n");
1238: printf(" (expression 2)\n");
1239: printf(" NEXT\n\n");
1240:
1.1 bertrand 1241: printf(" DO\n");
1242: printf(" (expression 1)\n");
1243: printf(" EXIT\n");
1244: printf(" (expression 2)\n");
1245: printf(" UNTIL\n");
1246: printf(" (expression test 1)\n");
1247: printf(" [EXIT\n");
1248: printf(" (expression test 2)]\n");
1249: printf(" END\n\n");
1250:
1251: printf(" WHILE\n");
1252: printf(" (expression test 1)\n");
1253: printf(" [EXIT\n");
1254: printf(" (expression test 2)]\n");
1255: printf(" REPEAT\n");
1256: printf(" (expression 1)\n");
1257: printf(" EXIT\n");
1258: printf(" (expression 2)\n");
1259: printf(" END\n");
1260:
1261: return;
1262: }
1263: else if ((*s_etat_processus).test_instruction == 'Y')
1264: {
1265: (*s_etat_processus).nombre_arguments = -1;
1266: return;
1267: }
1268:
1269: /*
1270: * Test de la présence de l'instruction EXIT dans une boucle
1271: */
1272:
1273: l_element_pile_systeme = (*s_etat_processus).l_base_pile_systeme;
1274: presence_boucle = d_faux;
1275: drapeau_boucle_definie = d_faux;
1276:
1277: while((l_element_pile_systeme != NULL) && (presence_boucle == d_faux))
1278: {
1279: if (((*l_element_pile_systeme).type_cloture == 'S') ||
1.39 bertrand 1280: ((*l_element_pile_systeme).type_cloture == 'F') ||
1281: ((*l_element_pile_systeme).type_cloture == 'A'))
1.1 bertrand 1282: {
1283: presence_boucle = d_vrai;
1284: drapeau_boucle_definie = d_vrai;
1285: }
1286: else if (((*l_element_pile_systeme).type_cloture == 'D') ||
1287: ((*l_element_pile_systeme).type_cloture == 'W'))
1288: {
1289: presence_boucle = d_vrai;
1290: drapeau_boucle_definie = d_faux;
1291: }
1292:
1293: l_element_pile_systeme = (*l_element_pile_systeme).suivant;
1294: }
1295:
1296: if (presence_boucle == d_faux)
1297: {
1298: (*s_etat_processus).erreur_execution = d_ex_exit_hors_boucle;
1299: return;
1300: }
1301:
1302: if ((*s_etat_processus).mode_execution_programme == 'Y')
1303: {
1304: drapeau_presence_fin_boucle = d_vrai;
1305: tampon = (*s_etat_processus).instruction_courante;
1306: niveau = 1;
1307:
1.59 bertrand 1308: instruction_majuscule = conversion_majuscule(s_etat_processus, "");
1.1 bertrand 1309:
1310: if (drapeau_boucle_definie == d_vrai)
1311: {
1312: while(!(((strcmp(instruction_majuscule, "NEXT") == 0) ||
1313: (strcmp(instruction_majuscule, "STEP") == 0)) &&
1314: (niveau == 0)))
1315: {
1316: free(instruction_majuscule);
1317:
1318: erreur = recherche_instruction_suivante(s_etat_processus);
1319:
1320: if (erreur == d_erreur)
1321: {
1322: return;
1323: }
1324:
1.39 bertrand 1325: (*s_etat_processus).erreur_systeme = d_es;
1.59 bertrand 1326: instruction_majuscule = conversion_majuscule(s_etat_processus,
1.39 bertrand 1327: (*s_etat_processus).instruction_courante);
1328:
1329: if (instruction_majuscule == NULL)
1.1 bertrand 1330: {
1.39 bertrand 1331: return;
1332: }
1.1 bertrand 1333:
1.39 bertrand 1334: /*
1335: * Traitement de la pile système par les
1336: * différentes instructions.
1337: */
1338:
1339: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1340: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1341: (strcmp(instruction_majuscule, "DO") == 0) ||
1342: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1343: (strcmp(instruction_majuscule, "FOR") == 0) ||
1.46 bertrand 1344: (strcmp(instruction_majuscule, "FORALL") == 0) ||
1.39 bertrand 1345: (strcmp(instruction_majuscule, "START") == 0) ||
1346: (strcmp(instruction_majuscule, "SELECT") == 0)
1347: || (strcmp(instruction_majuscule, "CRITICAL") == 0)
1348: || (strcmp(instruction_majuscule, "CASE") == 0)
1349: || (strcmp(instruction_majuscule, "<<") == 0))
1350: {
1351: if (strcmp(instruction_majuscule, "<<") == 0)
1352: {
1353: analyse(s_etat_processus, NULL);
1354: }
1355: else
1.1 bertrand 1356: {
1.39 bertrand 1357: if ((strcmp(instruction_majuscule, "FOR") == 0) ||
1.46 bertrand 1358: (strcmp(instruction_majuscule, "FORALL") == 0)
1.47 bertrand 1359: || (strcmp(instruction_majuscule, "START")
1.39 bertrand 1360: == 0))
1.1 bertrand 1361: {
1.39 bertrand 1362: niveau++;
1.1 bertrand 1363: }
1364:
1.39 bertrand 1365: empilement_pile_systeme(s_etat_processus);
1.1 bertrand 1366:
1.39 bertrand 1367: if ((*s_etat_processus).erreur_systeme != d_es)
1.1 bertrand 1368: {
1369: return;
1370: }
1371: }
1372: }
1.39 bertrand 1373: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1374: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1375: (strcmp(instruction_majuscule, "STEP") == 0) ||
1376: (strcmp(instruction_majuscule, ">>") == 0))
1.1 bertrand 1377: {
1.39 bertrand 1378: if (strcmp(instruction_majuscule, ">>") == 0)
1.1 bertrand 1379: {
1.39 bertrand 1380: analyse(s_etat_processus, NULL);
1.1 bertrand 1381:
1.39 bertrand 1382: if ((*s_etat_processus).retour_routine_evaluation
1383: == 'Y')
1.1 bertrand 1384: {
1.39 bertrand 1385: drapeau_presence_fin_boucle = d_faux;
1386: free((*s_etat_processus).instruction_courante);
1.1 bertrand 1387:
1.39 bertrand 1388: break;
1.1 bertrand 1389: }
1390: }
1.39 bertrand 1391: else
1.1 bertrand 1392: {
1.39 bertrand 1393: if ((strcmp(instruction_majuscule, "NEXT") == 0) ||
1394: (strcmp(instruction_majuscule, "STEP")
1395: == 0))
1.1 bertrand 1396: {
1.39 bertrand 1397: niveau--;
1.1 bertrand 1398:
1.39 bertrand 1399: if (niveau != 0)
1.1 bertrand 1400: {
1.39 bertrand 1401: depilement_pile_systeme(s_etat_processus);
1.1 bertrand 1402: }
1403: }
1404: else
1405: {
1.39 bertrand 1406: if ((*s_etat_processus).l_base_pile_systeme == NULL)
1.1 bertrand 1407: {
1.39 bertrand 1408: (*s_etat_processus).erreur_systeme =
1409: d_es_processus;
1410: return;
1411: }
1.1 bertrand 1412:
1.39 bertrand 1413: if ((*(*s_etat_processus).l_base_pile_systeme)
1414: .type_cloture == 'Q')
1415: {
1416: if (pthread_mutex_unlock(
1417: &mutex_sections_critiques) != 0)
1.1 bertrand 1418: {
1.39 bertrand 1419: (*s_etat_processus).erreur_systeme =
1420: d_es_processus;
1421: return;
1.1 bertrand 1422: }
1.39 bertrand 1423:
1424: (*s_etat_processus).sections_critiques--;
1.1 bertrand 1425: }
1426:
1.39 bertrand 1427: depilement_pile_systeme(s_etat_processus);
1428: }
1429:
1430: if ((*s_etat_processus).erreur_systeme != d_es)
1431: {
1432: return;
1.1 bertrand 1433: }
1434: }
1435: }
1436:
1437: free((*s_etat_processus).instruction_courante);
1438: }
1439: }
1440: else
1441: {
1442: while(!((strcmp(instruction_majuscule, "END") == 0) &&
1443: (niveau == 0)))
1444: {
1445: free(instruction_majuscule);
1446:
1447: erreur = recherche_instruction_suivante(s_etat_processus);
1448:
1449: if (erreur == d_erreur)
1450: {
1451: return;
1452: }
1453:
1.59 bertrand 1454: instruction_majuscule = conversion_majuscule(s_etat_processus,
1.39 bertrand 1455: (*s_etat_processus).instruction_courante);
1456:
1457: if (instruction_majuscule == NULL)
1.1 bertrand 1458: {
1.39 bertrand 1459: return;
1460: }
1.1 bertrand 1461:
1.39 bertrand 1462: /*
1463: * Traitement de la pile système par les
1464: * différentes instructions.
1465: */
1466:
1467: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1468: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1469: (strcmp(instruction_majuscule, "DO") == 0) ||
1470: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1471: (strcmp(instruction_majuscule, "FOR") == 0) ||
1.46 bertrand 1472: (strcmp(instruction_majuscule, "FORALL") == 0) ||
1.39 bertrand 1473: (strcmp(instruction_majuscule, "START") == 0) ||
1474: (strcmp(instruction_majuscule, "SELECT") == 0)
1475: || (strcmp(instruction_majuscule, "CRITICAL") == 0)
1476: || (strcmp(instruction_majuscule, "CASE") == 0)
1477: || (strcmp(instruction_majuscule, "<<") == 0))
1478: {
1479: if (strcmp(instruction_majuscule, "<<") == 0)
1.1 bertrand 1480: {
1.39 bertrand 1481: analyse(s_etat_processus, NULL);
1482: }
1483: else
1484: {
1485: if ((strcmp(instruction_majuscule, "DO") == 0) ||
1486: (strcmp(instruction_majuscule, "WHILE")
1487: == 0))
1.1 bertrand 1488: {
1.39 bertrand 1489: niveau++;
1.1 bertrand 1490: }
1491:
1.39 bertrand 1492: empilement_pile_systeme(s_etat_processus);
1.1 bertrand 1493:
1.39 bertrand 1494: if ((*s_etat_processus).erreur_systeme != d_es)
1.1 bertrand 1495: {
1.39 bertrand 1496: return;
1.1 bertrand 1497: }
1.39 bertrand 1498: }
1499: }
1500: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1501: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1502: (strcmp(instruction_majuscule, "STEP") == 0) ||
1503: (strcmp(instruction_majuscule, ">>") == 0))
1504: {
1505: if (strcmp(instruction_majuscule, ">>") == 0)
1506: {
1507: analyse(s_etat_processus, NULL);
1.1 bertrand 1508:
1.39 bertrand 1509: if ((*s_etat_processus).retour_routine_evaluation
1510: == 'Y')
1.1 bertrand 1511: {
1.39 bertrand 1512: drapeau_presence_fin_boucle = d_faux;
1513: free((*s_etat_processus).instruction_courante);
1514:
1515: break;
1.1 bertrand 1516: }
1517: }
1518: else
1519: {
1.39 bertrand 1520: if (strcmp(instruction_majuscule, "END") == 0)
1.1 bertrand 1521: {
1.39 bertrand 1522: if (((*(*s_etat_processus).l_base_pile_systeme)
1523: .type_cloture == 'D') ||
1524: ((*(*s_etat_processus)
1525: .l_base_pile_systeme).type_cloture
1526: == 'W'))
1.1 bertrand 1527: {
1.39 bertrand 1528: niveau--;
1.1 bertrand 1529: }
1530:
1.39 bertrand 1531: depilement_pile_systeme(s_etat_processus);
1.1 bertrand 1532: }
1533: else
1534: {
1.39 bertrand 1535: if ((*s_etat_processus).l_base_pile_systeme == NULL)
1.1 bertrand 1536: {
1.39 bertrand 1537: (*s_etat_processus).erreur_systeme =
1538: d_es_processus;
1.1 bertrand 1539: return;
1540: }
1541:
1.39 bertrand 1542: if ((*(*s_etat_processus).l_base_pile_systeme)
1543: .type_cloture == 'Q')
1.1 bertrand 1544: {
1.39 bertrand 1545: if (pthread_mutex_unlock(
1546: &mutex_sections_critiques) != 0)
1.1 bertrand 1547: {
1.39 bertrand 1548: (*s_etat_processus).erreur_systeme =
1549: d_es_processus;
1550: return;
1.1 bertrand 1551: }
1552:
1.39 bertrand 1553: (*s_etat_processus).sections_critiques--;
1.1 bertrand 1554: }
1555:
1.39 bertrand 1556: depilement_pile_systeme(s_etat_processus);
1557: }
1558:
1559: if ((*s_etat_processus).erreur_systeme != d_es)
1560: {
1561: return;
1.1 bertrand 1562: }
1563: }
1564: }
1565:
1566: free((*s_etat_processus).instruction_courante);
1567: }
1568: }
1569:
1570: if (drapeau_presence_fin_boucle == d_faux)
1571: {
1572: (*s_etat_processus).traitement_cycle_exit = 'E';
1573: }
1574: else
1575: {
1576: (*s_etat_processus).traitement_cycle_exit = 'N';
1577: }
1578:
1579: free(instruction_majuscule);
1580: (*s_etat_processus).instruction_courante = tampon;
1581: }
1582: else
1583: {
1584: /* EXIT apparaissant dans l'évaluation d'une expression */
1585:
1586: drapeau_presence_fin_boucle = d_faux;
1587: instruction_majuscule = NULL;
1588: niveau = 1;
1589:
1590: if (drapeau_boucle_definie == d_vrai)
1591: {
1592: while((*s_etat_processus).expression_courante != NULL)
1593: {
1594: while((*(*(*s_etat_processus).expression_courante)
1595: .donnee).type != FCT)
1596: {
1597: if ((*s_etat_processus).expression_courante == NULL)
1598: {
1599: (*s_etat_processus).erreur_execution =
1600: d_ex_erreur_traitement_boucle;
1601: return;
1602: }
1603:
1604: (*s_etat_processus).expression_courante =
1605: (*(*s_etat_processus).expression_courante).suivant;
1606: }
1607:
1608: fonction = (*((struct_fonction *) (*(*(*s_etat_processus)
1609: .expression_courante).donnee).objet)).fonction;
1610:
1611: if ((fonction == instruction_if) ||
1612: (fonction == instruction_iferr) ||
1613: (fonction == instruction_do) ||
1614: (fonction == instruction_while) ||
1615: (fonction == instruction_for) ||
1.46 bertrand 1616: (fonction == instruction_forall) ||
1.1 bertrand 1617: (fonction == instruction_start) ||
1618: (fonction == instruction_select) ||
1619: (fonction == instruction_case) ||
1.39 bertrand 1620: (fonction == instruction_critical) ||
1.1 bertrand 1621: (fonction == instruction_vers_niveau_superieur))
1622: {
1623: if (fonction == instruction_vers_niveau_superieur)
1624: {
1625: analyse(s_etat_processus,
1626: instruction_vers_niveau_superieur);
1627: }
1628: else
1629: {
1630: if ((fonction == instruction_for) ||
1.46 bertrand 1631: (fonction == instruction_forall) ||
1.1 bertrand 1632: (fonction == instruction_start))
1633: {
1634: niveau++;
1635: }
1636:
1637: empilement_pile_systeme(s_etat_processus);
1638:
1639: if ((*s_etat_processus).erreur_systeme != d_es)
1640: {
1641: return;
1642: }
1643: }
1644: }
1645: else if ((fonction == instruction_end) ||
1646: (fonction == instruction_next) ||
1647: (fonction == instruction_step) ||
1648: (fonction == instruction_vers_niveau_inferieur))
1649: {
1650: if (fonction == instruction_vers_niveau_inferieur)
1651: {
1652: tampon = (*s_etat_processus).instruction_courante;
1653: (*s_etat_processus).instruction_courante =
1654: instruction_majuscule;
1655:
1656: analyse(s_etat_processus,
1657: instruction_vers_niveau_inferieur);
1658:
1659: (*s_etat_processus).instruction_courante = tampon;
1660: }
1661: else
1662: {
1663: if ((fonction == instruction_next) ||
1664: (fonction == instruction_step))
1665: {
1666: niveau--;
1667:
1668: if (niveau != 0)
1669: {
1670: depilement_pile_systeme(s_etat_processus);
1671: }
1672: else
1673: {
1674: drapeau_presence_fin_boucle = d_vrai;
1675: break;
1676: }
1677: }
1678: else
1679: {
1.39 bertrand 1680: if ((*s_etat_processus).l_base_pile_systeme == NULL)
1681: {
1682: (*s_etat_processus).erreur_systeme =
1683: d_es_processus;
1684: return;
1685: }
1686:
1687: if ((*(*s_etat_processus).l_base_pile_systeme)
1688: .type_cloture == 'Q')
1689: {
1690: if (pthread_mutex_unlock(
1691: &mutex_sections_critiques) != 0)
1692: {
1693: (*s_etat_processus).erreur_systeme =
1694: d_es_processus;
1695: return;
1696: }
1697:
1698: (*s_etat_processus).sections_critiques--;
1699: }
1700:
1.1 bertrand 1701: depilement_pile_systeme(s_etat_processus);
1702: }
1703:
1704: if ((*s_etat_processus).erreur_systeme != d_es)
1705: {
1706: return;
1707: }
1708: }
1709: }
1710:
1711: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
1712: .expression_courante).suivant;
1713: }
1714: }
1715: else
1716: {
1717: while((*s_etat_processus).expression_courante != NULL)
1718: {
1719: while((*(*(*s_etat_processus).expression_courante)
1720: .donnee).type != FCT)
1721: {
1722: if ((*s_etat_processus).expression_courante == NULL)
1723: {
1724: (*s_etat_processus).erreur_execution =
1725: d_ex_erreur_traitement_boucle;
1726: return;
1727: }
1728:
1729: (*s_etat_processus).expression_courante =
1730: (*(*s_etat_processus).expression_courante).suivant;
1731: }
1732:
1733: fonction = (*((struct_fonction *) (*(*(*s_etat_processus)
1734: .expression_courante).donnee).objet)).fonction;
1735:
1736: if ((fonction == instruction_if) ||
1737: (fonction == instruction_iferr) ||
1738: (fonction == instruction_do) ||
1739: (fonction == instruction_while) ||
1740: (fonction == instruction_for) ||
1.46 bertrand 1741: (fonction == instruction_forall) ||
1.1 bertrand 1742: (fonction == instruction_start) ||
1743: (fonction == instruction_select) ||
1.39 bertrand 1744: (fonction == instruction_critical) ||
1.1 bertrand 1745: (fonction == instruction_case) ||
1746: (fonction == instruction_vers_niveau_superieur))
1747: {
1748: if (fonction == instruction_vers_niveau_superieur)
1749: {
1750: analyse(s_etat_processus,
1751: instruction_vers_niveau_superieur);
1752: }
1753: else
1754: {
1755: if ((fonction == instruction_do) ||
1756: (fonction == instruction_while))
1757: {
1758: niveau++;
1759: }
1760:
1761: empilement_pile_systeme(s_etat_processus);
1762:
1763: if ((*s_etat_processus).erreur_systeme != d_es)
1764: {
1765: return;
1766: }
1767: }
1768: }
1769: else if ((fonction == instruction_end) ||
1770: (fonction == instruction_next) ||
1771: (fonction == instruction_step) ||
1772: (fonction == instruction_vers_niveau_inferieur))
1773: {
1774: if (fonction == instruction_vers_niveau_inferieur)
1775: {
1776: analyse(s_etat_processus,
1777: instruction_vers_niveau_inferieur);
1778: }
1779: else
1780: {
1781: if (fonction == instruction_end)
1782: {
1783: if (((*(*s_etat_processus).l_base_pile_systeme)
1784: .type_cloture == 'D') ||
1785: ((*(*s_etat_processus).l_base_pile_systeme)
1786: .type_cloture == 'W'))
1787: {
1788: niveau--;
1789: }
1790:
1791: depilement_pile_systeme(s_etat_processus);
1792:
1793: if (niveau == 0)
1794: {
1795: drapeau_presence_fin_boucle = d_vrai;
1796: break;
1797: }
1798: }
1799: else
1800: {
1.39 bertrand 1801: if ((*s_etat_processus).l_base_pile_systeme == NULL)
1802: {
1803: (*s_etat_processus).erreur_systeme =
1804: d_es_processus;
1805: return;
1806: }
1807:
1808: if ((*(*s_etat_processus).l_base_pile_systeme)
1809: .type_cloture == 'Q')
1810: {
1811: if (pthread_mutex_unlock(
1812: &mutex_sections_critiques) != 0)
1813: {
1814: (*s_etat_processus).erreur_systeme =
1815: d_es_processus;
1816: return;
1817: }
1818:
1819: (*s_etat_processus).sections_critiques--;
1820: }
1821:
1.1 bertrand 1822: depilement_pile_systeme(s_etat_processus);
1823: }
1824:
1825: if ((*s_etat_processus).erreur_systeme != d_es)
1826: {
1827: return;
1828: }
1829: }
1830: }
1831:
1832: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
1833: .expression_courante).suivant;
1834: }
1835: }
1836:
1837: if (drapeau_presence_fin_boucle == d_faux)
1838: {
1839: (*s_etat_processus).traitement_cycle_exit = 'E';
1840: }
1841: else
1842: {
1843: (*s_etat_processus).traitement_cycle_exit = 'N';
1844: }
1845: }
1846:
1847: if ((drapeau_boucle_definie == d_vrai) &&
1848: (drapeau_presence_fin_boucle == d_vrai))
1849: {
1.47 bertrand 1850: presence_compteur = (((*(*s_etat_processus).l_base_pile_systeme)
1851: .type_cloture == 'F') || ((*(*s_etat_processus)
1852: .l_base_pile_systeme).type_cloture == 'A')) ? d_vrai : d_faux;
1.1 bertrand 1853:
1854: if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
1855: && (presence_compteur == d_faux))
1856: {
1857: (*s_etat_processus).erreur_execution =
1858: d_ex_erreur_traitement_boucle;
1859: return;
1860: }
1861:
1862: depilement_pile_systeme(s_etat_processus);
1863:
1864: if ((*s_etat_processus).erreur_systeme != d_es)
1865: {
1866: return;
1867: }
1868:
1869: if (presence_compteur == d_vrai)
1870: {
1871: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
1872: (*s_etat_processus).niveau_courant--;
1873:
1.41 bertrand 1874: if (retrait_variables_par_niveau(s_etat_processus) == d_erreur)
1.1 bertrand 1875: {
1876: return;
1877: }
1878: }
1879: }
1880:
1881: return;
1882: }
1883:
1884: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to instructions_e2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src