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 '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:
626: unsigned int registre_erreur_execution;
627: unsigned int registre_erreur_systeme;
628: unsigned int registre_exception;
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
724: # include "vim.conv.h"
725:
726: file *fichier;
727:
728: logical1 drapeau;
729: logical1 drapeau49;
730: logical1 drapeau50;
731:
732: struct_liste_chainee *registre_pile_last;
733:
734: struct_objet *s_copie;
735: struct_objet *s_objet;
736: struct_objet *s_objet_nom;
737:
738: unsigned char *chaine;
739: unsigned char *commande;
740: unsigned char *nom_fichier;
741: unsigned char registre;
742:
743: (*s_etat_processus).erreur_execution = d_ex;
744:
745: if ((*s_etat_processus).affichage_arguments == 'Y')
746: {
747: printf("\n EDIT ");
748:
749: if ((*s_etat_processus).langue == 'F')
750: {
751: printf("(édition d'un objet)\n\n");
752: }
753: else
754: {
755: printf("(edit object)\n\n");
756: }
757:
758: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
759: " %s, %s, %s, %s, %s,\n"
760: " %s, %s, %s, %s, %s\n",
761: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
762: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
763: printf("-> n: %s, %s, %s, %s, %s, %s,\n"
764: " %s, %s, %s, %s, %s,\n"
765: " %s, %s, %s, %s, %s\n",
766: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
767: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
768: printf(" ...\n");
769: printf(" 1: %s, %s, %s, %s, %s, %s,\n"
770: " %s, %s, %s, %s, %s,\n"
771: " %s, %s, %s, %s, %s\n",
772: d_INT, d_REL, d_CPL, d_VIN, d_VRL, d_VCX, d_MIN, d_MRL, d_MCX,
773: d_TAB, d_BIN, d_NOM, d_CHN, d_LST, d_ALG, d_RPN);
774: return;
775: }
776: else if ((*s_etat_processus).test_instruction == 'Y')
777: {
778: (*s_etat_processus).nombre_arguments = -1;
779: return;
780: }
781:
782: if (test_cfsf(s_etat_processus, 31) == d_vrai)
783: {
784: if (empilement_pile_last(s_etat_processus, 1) == d_erreur)
785: {
786: return;
787: }
788: }
789:
790: if (depilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
791: &s_objet) == d_erreur)
792: {
793: (*s_etat_processus).erreur_execution = d_ex_manque_argument;
794: return;
795: }
796:
797: if (((*s_objet).type != INT) &&
798: ((*s_objet).type != REL) &&
799: ((*s_objet).type != CPL) &&
800: ((*s_objet).type != VIN) &&
801: ((*s_objet).type != VRL) &&
802: ((*s_objet).type != VCX) &&
803: ((*s_objet).type != MIN) &&
804: ((*s_objet).type != MRL) &&
805: ((*s_objet).type != MCX) &&
806: ((*s_objet).type != TBL) &&
807: ((*s_objet).type != BIN) &&
808: ((*s_objet).type != NOM) &&
809: ((*s_objet).type != CHN) &&
810: ((*s_objet).type != LST) &&
811: ((*s_objet).type != ALG) &&
812: ((*s_objet).type != RPN))
813: {
814: liberation(s_etat_processus, s_objet);
815:
816: (*s_etat_processus).erreur_execution = d_ex_erreur_type_argument;
817: return;
818: }
819:
820: if ((s_copie = copie_objet(s_etat_processus, s_objet, 'O')) == NULL)
821: {
822: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
823: return;
824: }
825:
826: liberation(s_etat_processus, s_objet);
827: s_objet = s_copie;
828:
829: // Création d'un fichier temporaire à éditer
830:
831: if ((nom_fichier = creation_nom_fichier(s_etat_processus,
832: (*s_etat_processus).chemin_fichiers_temporaires)) == NULL)
833: {
834: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
835: return;
836: }
837:
838: drapeau49 = test_cfsf(s_etat_processus, 49);
839: drapeau50 = test_cfsf(s_etat_processus, 50);
840:
841: cf(s_etat_processus, 49);
842: cf(s_etat_processus, 50);
843:
844: // Ecriture de l'objet dans le fichier en mode STD et multiligne
845:
846: if ((fichier = fopen(nom_fichier, "w+")) == NULL)
847: {
848: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
849: return;
850: }
851:
852: registre = (*s_etat_processus).autorisation_conversion_chaine;
853: (*s_etat_processus).autorisation_conversion_chaine = 'N';
854:
855: if ((chaine = formateur(s_etat_processus, 0, s_objet)) == NULL)
856: {
857: (*s_etat_processus).autorisation_conversion_chaine = registre;
858:
859: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
860: return;
861: }
862:
863: (*s_etat_processus).autorisation_conversion_chaine = registre;
864:
865: if ((*s_objet).type == CHN)
866: {
867: if (fprintf(fichier, "\"%s\"\n", chaine) != (int) (strlen(chaine) + 3))
868: {
869: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
870: return;
871: }
872: }
873: else
874: {
875: if (fprintf(fichier, "%s\n", chaine) != (int) (strlen(chaine) + 1))
876: {
877: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
878: return;
879: }
880: }
881:
882: free(chaine);
883:
884: if (fclose(fichier) != 0)
885: {
886: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
887: return;
888: }
889:
890: do
891: {
892: if ((commande = malloc((strlen(ds_vim_commande) + strlen(nom_fichier)
893: - 1) * sizeof(unsigned char))) == NULL)
894: {
895: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
896: return;
897: }
898:
899: sprintf(commande, ds_vim_commande, nom_fichier);
900:
901: if (system(commande) != 0)
902: {
903: free(commande);
904:
905: (*s_etat_processus).erreur_systeme = d_es_processus;
906: return;
907: }
908:
909: free(commande);
910:
911: if ((s_objet_nom = allocation(s_etat_processus, CHN)) == NULL)
912: {
913: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
914: return;
915: }
916:
917: if (((*s_objet_nom).objet = malloc((strlen(nom_fichier) + 1)
918: * sizeof(unsigned char))) == NULL)
919: {
920: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
921: return;
922: }
923:
924: strcpy((unsigned char *) (*s_objet_nom).objet, nom_fichier);
925:
926: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
927: s_objet_nom) == d_erreur)
928: {
929: return;
930: }
931:
932: registre_pile_last = (*s_etat_processus).l_base_pile_last;
933: (*s_etat_processus).l_base_pile_last = NULL;
934:
935: instruction_recall(s_etat_processus);
936:
937: // Destruction du fichier temporaire
938:
939: if (destruction_fichier(nom_fichier) == d_erreur)
940: {
941: (*s_etat_processus).erreur_systeme = d_es_erreur_fichier;
942: return;
943: }
944:
945: free(nom_fichier);
946:
947: if (((*s_etat_processus).erreur_systeme != d_es) ||
948: ((*s_etat_processus).erreur_execution != d_ex) ||
949: ((*s_etat_processus).exception != d_ep))
950: {
951: if (empilement_pile_last(s_etat_processus, 0) == d_erreur)
952: {
953: return;
954: }
955:
956: (*s_etat_processus).l_base_pile_last = registre_pile_last;
957: liberation(s_etat_processus, s_objet);
958:
959: return;
960: }
961:
962: if ((*s_etat_processus).erreur_systeme != d_es)
963: {
964: return;
965: }
966:
967: if ((*s_etat_processus).erreur_execution == d_ex_fichier_vide)
968: {
969: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
970: s_objet) == d_erreur)
971: {
972: return;
973: }
974:
975: (*s_etat_processus).erreur_execution = d_ex;
976: drapeau = d_faux;
977: }
978: else
979: {
980: drapeau = d_vrai;
981: }
982: } while((*s_etat_processus).erreur_execution != d_ex);
983:
984: if (drapeau == d_vrai)
985: {
986: liberation(s_etat_processus, s_objet);
987: }
988:
989: if (drapeau49 == d_vrai)
990: {
991: sf(s_etat_processus, 49);
992: }
993: else
994: {
995: cf(s_etat_processus, 49);
996: }
997:
998: if (drapeau50 == d_vrai)
999: {
1000: sf(s_etat_processus, 50);
1001: }
1002: else
1003: {
1004: cf(s_etat_processus, 50);
1005: }
1006:
1007: # endif
1008:
1009: return;
1010: }
1011:
1012:
1013: /*
1014: ================================================================================
1015: Fonction 'externals'
1016: ================================================================================
1017: Entrées : structure processus
1018: --------------------------------------------------------------------------------
1019: Sorties :
1020: --------------------------------------------------------------------------------
1021: Effets de bord : néant
1022: ================================================================================
1023: */
1024:
1025: void
1026: instruction_externals(struct_processus *s_etat_processus)
1027: {
1028: logical1 ambiguite;
1029:
1030: unsigned long i;
1031:
1032: struct_liste_chainee *l_element_courant;
1033:
1034: struct_objet *s_objet;
1035:
1036: (*s_etat_processus).erreur_execution = d_ex;
1037:
1038: if ((*s_etat_processus).affichage_arguments == 'Y')
1039: {
1040: printf("\n EXTERNALS ");
1041:
1042: if ((*s_etat_processus).langue == 'F')
1043: {
1044: printf("(liste des définitions externes)\n\n");
1045: }
1046: else
1047: {
1048: printf("(list of external definitions)\n\n");
1049: }
1050:
1051: printf("-> 1: %s\n", d_LST);
1052: return;
1053: }
1054: else if ((*s_etat_processus).test_instruction == 'Y')
1055: {
1056: (*s_etat_processus).nombre_arguments = -1;
1057: return;
1058: }
1059:
1060: if ((s_objet = allocation(s_etat_processus, LST)) == NULL)
1061: {
1062: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1063: return;
1064: }
1065:
1066: (*s_objet).objet = NULL;
1067:
1068: /*
1069: * { "fonction" } si la fonction n'est pas ambiguë
1070: * { "bibliotheque$fonction" } sinon.
1071: */
1072:
1073: l_element_courant = NULL;
1074:
1075: for(i = 0; i < (*s_etat_processus).nombre_instructions_externes; i++)
1076: {
1077: if (l_element_courant == NULL)
1078: {
1079: if (((*s_objet).objet = allocation_maillon(s_etat_processus))
1080: == NULL)
1081: {
1082: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1083: return;
1084: }
1085:
1086: l_element_courant = (*s_objet).objet;
1087: }
1088: else
1089: {
1090: if (((*l_element_courant).suivant =
1091: allocation_maillon(s_etat_processus)) == NULL)
1092: {
1093: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1094: return;
1095: }
1096:
1097: l_element_courant = (*l_element_courant).suivant;
1098: }
1099:
1100: (*l_element_courant).suivant = NULL;
1101:
1102: if (((*l_element_courant).donnee = allocation(s_etat_processus, CHN))
1103: == NULL)
1104: {
1105: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1106: return;
1107: }
1108:
1109: ambiguite = d_faux;
1110:
1111: if (i > 0)
1112: {
1113: if (strcmp((*s_etat_processus).s_instructions_externes[i].nom,
1114: (*s_etat_processus).s_instructions_externes[i - 1].nom)
1115: == 0)
1116: {
1117: ambiguite = d_vrai;
1118: }
1119: }
1120:
1121: if (((i + 1) < (*s_etat_processus).nombre_instructions_externes) &&
1122: (ambiguite == d_faux))
1123: {
1124: if (strcmp((*s_etat_processus).s_instructions_externes[i].nom,
1125: (*s_etat_processus).s_instructions_externes[i + 1].nom)
1126: == 0)
1127: {
1128: ambiguite = d_vrai;
1129: }
1130: }
1131:
1132: if (ambiguite == d_faux)
1133: {
1134: if (((*(*l_element_courant).donnee).objet = malloc((strlen(
1135: (*s_etat_processus).s_instructions_externes[i].nom) + 1)
1136: * sizeof(unsigned char))) == NULL)
1137: {
1138: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1139: return;
1140: }
1141:
1142: strcpy((unsigned char *) (*(*l_element_courant).donnee).objet,
1143: (*s_etat_processus).s_instructions_externes[i].nom);
1144: }
1145: else
1146: {
1147: if (((*(*l_element_courant).donnee).objet = malloc((strlen(
1148: (*s_etat_processus).s_instructions_externes[i].nom) +
1149: strlen((*s_etat_processus).s_instructions_externes[i]
1150: .nom_bibliotheque) + 2) * sizeof(unsigned char))) == NULL)
1151: {
1152: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1153: return;
1154: }
1155:
1156: sprintf((unsigned char *) (*(*l_element_courant).donnee).objet,
1157: "%s$%s", (*s_etat_processus).s_instructions_externes[i]
1158: .nom_bibliotheque, (*s_etat_processus)
1159: .s_instructions_externes[i].nom);
1160: }
1161: }
1162:
1163: if (empilement(s_etat_processus, &((*s_etat_processus).l_base_pile),
1164: s_objet) == d_erreur)
1165: {
1166: return;
1167: }
1168:
1169: return;
1170: }
1171:
1172:
1173: /*
1174: ================================================================================
1175: Fonction 'exit'
1176: ================================================================================
1177: Entrées : structure processus
1178: --------------------------------------------------------------------------------
1179: Sorties :
1180: --------------------------------------------------------------------------------
1181: Effets de bord : néant
1182: ================================================================================
1183: */
1184:
1185: void
1186: instruction_exit(struct_processus *s_etat_processus)
1187: {
1188: logical1 drapeau_boucle_definie;
1189: logical1 drapeau_presence_fin_boucle;
1190: logical1 erreur;
1191: logical1 presence_boucle;
1192: logical1 presence_compteur;
1193:
1194: struct_liste_pile_systeme *l_element_pile_systeme;
1195:
1196: unsigned char *instruction_majuscule;
1197: unsigned char *tampon;
1198:
1199: unsigned long niveau;
1200:
1201: void (*fonction)();
1202:
1203: (*s_etat_processus).erreur_execution = d_ex;
1204:
1205: if ((*s_etat_processus).affichage_arguments == 'Y')
1206: {
1207: printf("\n EXIT ");
1208:
1209: if ((*s_etat_processus).langue == 'F')
1210: {
1211: printf("(structure de contrôle)\n\n");
1212: printf(" Utilisation :\n\n");
1213: }
1214: else
1215: {
1216: printf("(control statement)\n\n");
1217: printf(" Usage:\n\n");
1218: }
1219:
1220: printf(" START/FOR\n");
1221: printf(" (expression 1)\n");
1222: printf(" EXIT\n");
1223: printf(" (expression 2)\n");
1224: printf(" NEXT/STEP\n\n");
1225:
1226: printf(" DO\n");
1227: printf(" (expression 1)\n");
1228: printf(" EXIT\n");
1229: printf(" (expression 2)\n");
1230: printf(" UNTIL\n");
1231: printf(" (expression test 1)\n");
1232: printf(" [EXIT\n");
1233: printf(" (expression test 2)]\n");
1234: printf(" END\n\n");
1235:
1236: printf(" WHILE\n");
1237: printf(" (expression test 1)\n");
1238: printf(" [EXIT\n");
1239: printf(" (expression test 2)]\n");
1240: printf(" REPEAT\n");
1241: printf(" (expression 1)\n");
1242: printf(" EXIT\n");
1243: printf(" (expression 2)\n");
1244: printf(" END\n");
1245:
1246: return;
1247: }
1248: else if ((*s_etat_processus).test_instruction == 'Y')
1249: {
1250: (*s_etat_processus).nombre_arguments = -1;
1251: return;
1252: }
1253:
1254: /*
1255: * Test de la présence de l'instruction EXIT dans une boucle
1256: */
1257:
1258: l_element_pile_systeme = (*s_etat_processus).l_base_pile_systeme;
1259: presence_boucle = d_faux;
1260: drapeau_boucle_definie = d_faux;
1261:
1262: while((l_element_pile_systeme != NULL) && (presence_boucle == d_faux))
1263: {
1264: if (((*l_element_pile_systeme).type_cloture == 'S') ||
1265: ((*l_element_pile_systeme).type_cloture == 'F'))
1266: {
1267: presence_boucle = d_vrai;
1268: drapeau_boucle_definie = d_vrai;
1269: }
1270: else if (((*l_element_pile_systeme).type_cloture == 'D') ||
1271: ((*l_element_pile_systeme).type_cloture == 'W'))
1272: {
1273: presence_boucle = d_vrai;
1274: drapeau_boucle_definie = d_faux;
1275: }
1276:
1277: l_element_pile_systeme = (*l_element_pile_systeme).suivant;
1278: }
1279:
1280: if (presence_boucle == d_faux)
1281: {
1282: (*s_etat_processus).erreur_execution = d_ex_exit_hors_boucle;
1283: return;
1284: }
1285:
1286: if ((*s_etat_processus).mode_execution_programme == 'Y')
1287: {
1288: drapeau_presence_fin_boucle = d_vrai;
1289: tampon = (*s_etat_processus).instruction_courante;
1290: niveau = 1;
1291:
1292: instruction_majuscule = conversion_majuscule("");
1293:
1294: if (drapeau_boucle_definie == d_vrai)
1295: {
1296: while(!(((strcmp(instruction_majuscule, "NEXT") == 0) ||
1297: (strcmp(instruction_majuscule, "STEP") == 0)) &&
1298: (niveau == 0)))
1299: {
1300: free(instruction_majuscule);
1301:
1302: erreur = recherche_instruction_suivante(s_etat_processus);
1303:
1304: if (erreur == d_erreur)
1305: {
1306: return;
1307: }
1308:
1309: if (recherche_variable(s_etat_processus,
1310: (*s_etat_processus).instruction_courante) == d_vrai)
1311: {
1312: instruction_majuscule = conversion_majuscule("");
1313:
1314: if ((*s_etat_processus).s_liste_variables
1315: [(*s_etat_processus).position_variable_courante]
1316: .objet == NULL)
1317: {
1318: if (pthread_mutex_lock(&((*(*s_etat_processus)
1319: .s_liste_variables_partagees).mutex)) != 0)
1320: {
1321: (*s_etat_processus).erreur_systeme =
1322: d_es_processus;
1323: return;
1324: }
1325:
1326: if (recherche_variable_partagee(s_etat_processus,
1327: (*s_etat_processus).s_liste_variables
1328: [(*s_etat_processus).position_variable_courante]
1329: .nom, (*s_etat_processus).s_liste_variables
1330: [(*s_etat_processus).position_variable_courante]
1331: .variable_partagee,
1332: (*s_etat_processus).s_liste_variables
1333: [(*s_etat_processus).position_variable_courante]
1334: .origine) == d_vrai)
1335: {
1336: if ((*((*s_etat_processus).s_liste_variables
1337: [(*s_etat_processus)
1338: .position_variable_courante]).objet).type
1339: == ADR)
1340: {
1341: empilement_pile_systeme(s_etat_processus);
1342:
1343: if ((*s_etat_processus).erreur_systeme != d_es)
1344: {
1345: if (pthread_mutex_unlock(
1346: &((*(*s_etat_processus)
1347: .s_liste_variables_partagees)
1348: .mutex)) != 0)
1349: {
1350: (*s_etat_processus).erreur_systeme =
1351: d_es_processus;
1352: return;
1353: }
1354:
1355: return;
1356: }
1357:
1358: (*(*s_etat_processus).l_base_pile_systeme)
1359: .adresse_retour =
1360: (*s_etat_processus).position_courante;
1361:
1362: (*(*s_etat_processus).l_base_pile_systeme)
1363: .retour_definition = 'Y';
1364: (*(*s_etat_processus).l_base_pile_systeme)
1365: .niveau_courant =
1366: (*s_etat_processus).niveau_courant;
1367:
1368: (*s_etat_processus).position_courante =
1369: (*((unsigned long *)
1370: ((*((*s_etat_processus)
1371: .s_liste_variables[(*s_etat_processus)
1372: .position_variable_courante].objet))
1373: .objet)));
1374:
1375: (*s_etat_processus)
1376: .autorisation_empilement_programme
1377: = 'N';
1378: }
1379: }
1380: else
1381: {
1382: (*s_etat_processus).erreur_systeme = d_es;
1383: }
1384:
1385: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1386: .s_liste_variables_partagees).mutex)) != 0)
1387: {
1388: (*s_etat_processus).erreur_systeme =
1389: d_es_processus;
1390: return;
1391: }
1392: }
1393: else
1394: {
1395: if ((*((*s_etat_processus).s_liste_variables
1396: [(*s_etat_processus)
1397: .position_variable_courante]).objet).type
1398: == ADR)
1399: {
1400: empilement_pile_systeme(s_etat_processus);
1401:
1402: if ((*s_etat_processus).erreur_systeme != d_es)
1403: {
1404: return;
1405: }
1406:
1407: (*(*s_etat_processus).l_base_pile_systeme)
1408: .adresse_retour =
1409: (*s_etat_processus).position_courante;
1410:
1411: (*(*s_etat_processus).l_base_pile_systeme)
1412: .retour_definition = 'Y';
1413: (*(*s_etat_processus).l_base_pile_systeme)
1414: .niveau_courant =
1415: (*s_etat_processus).niveau_courant;
1416:
1417: (*s_etat_processus).position_courante =
1418: (*((unsigned long *) ((*((*s_etat_processus)
1419: .s_liste_variables[(*s_etat_processus)
1420: .position_variable_courante].objet))
1421: .objet)));
1422:
1423: (*s_etat_processus)
1424: .autorisation_empilement_programme
1425: = 'N';
1426: }
1427: }
1428: }
1429: else
1430: {
1431: (*s_etat_processus).erreur_systeme = d_es;
1432: instruction_majuscule = conversion_majuscule(
1433: (*s_etat_processus).instruction_courante);
1434:
1435: if (instruction_majuscule == NULL)
1436: {
1437: return;
1438: }
1439:
1440: /*
1441: * Traitement de la pile système par les
1442: * différentes instructions.
1443: */
1444:
1445: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1446: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1447: (strcmp(instruction_majuscule, "DO") == 0) ||
1448: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1449: (strcmp(instruction_majuscule, "FOR") == 0) ||
1450: (strcmp(instruction_majuscule, "START") == 0) ||
1451: (strcmp(instruction_majuscule, "SELECT") == 0)
1452: || (strcmp(instruction_majuscule, "CASE") == 0)
1453: || (strcmp(instruction_majuscule, "<<") == 0))
1454: {
1455: if (strcmp(instruction_majuscule, "<<") == 0)
1456: {
1457: analyse(s_etat_processus, NULL);
1458: }
1459: else
1460: {
1461: if ((strcmp(instruction_majuscule, "FOR") == 0) ||
1462: (strcmp(instruction_majuscule, "START")
1463: == 0))
1464: {
1465: niveau++;
1466: }
1467:
1468: empilement_pile_systeme(s_etat_processus);
1469:
1470: if ((*s_etat_processus).erreur_systeme != d_es)
1471: {
1472: return;
1473: }
1474: }
1475: }
1476: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1477: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1478: (strcmp(instruction_majuscule, "STEP") == 0) ||
1479: (strcmp(instruction_majuscule, ">>") == 0))
1480: {
1481: if (strcmp(instruction_majuscule, ">>") == 0)
1482: {
1483: analyse(s_etat_processus, NULL);
1484:
1485: if ((*s_etat_processus).retour_routine_evaluation
1486: == 'Y')
1487: {
1488: drapeau_presence_fin_boucle = d_faux;
1489: free((*s_etat_processus).instruction_courante);
1490:
1491: break;
1492: }
1493: }
1494: else
1495: {
1496: if ((strcmp(instruction_majuscule, "NEXT") == 0) ||
1497: (strcmp(instruction_majuscule, "STEP")
1498: == 0))
1499: {
1500: niveau--;
1501:
1502: if (niveau != 0)
1503: {
1504: depilement_pile_systeme(s_etat_processus);
1505: }
1506: }
1507: else
1508: {
1509: depilement_pile_systeme(s_etat_processus);
1510: }
1511:
1512: if ((*s_etat_processus).erreur_systeme != d_es)
1513: {
1514: return;
1515: }
1516: }
1517: }
1518: }
1519:
1520: free((*s_etat_processus).instruction_courante);
1521: }
1522: }
1523: else
1524: {
1525: while(!((strcmp(instruction_majuscule, "END") == 0) &&
1526: (niveau == 0)))
1527: {
1528: free(instruction_majuscule);
1529:
1530: erreur = recherche_instruction_suivante(s_etat_processus);
1531:
1532: if (erreur == d_erreur)
1533: {
1534: return;
1535: }
1536:
1537: if (recherche_variable(s_etat_processus,
1538: (*s_etat_processus).instruction_courante) == d_vrai)
1539: {
1540: instruction_majuscule = conversion_majuscule("");
1541:
1542: if ((*s_etat_processus).s_liste_variables
1543: [(*s_etat_processus).position_variable_courante]
1544: .objet == NULL)
1545: {
1546: if (pthread_mutex_lock(&((*(*s_etat_processus)
1547: .s_liste_variables_partagees).mutex)) != 0)
1548: {
1549: (*s_etat_processus).erreur_systeme =
1550: d_es_processus;
1551: return;
1552: }
1553:
1554: if (recherche_variable_partagee(s_etat_processus,
1555: (*s_etat_processus).s_liste_variables
1556: [(*s_etat_processus).position_variable_courante]
1557: .nom, (*s_etat_processus).s_liste_variables
1558: [(*s_etat_processus).position_variable_courante]
1559: .variable_partagee,
1560: (*s_etat_processus).s_liste_variables
1561: [(*s_etat_processus).position_variable_courante]
1562: .origine) == d_vrai)
1563: {
1564: if ((*((*s_etat_processus).s_liste_variables
1565: [(*s_etat_processus)
1566: .position_variable_courante]).objet).type
1567: == ADR)
1568: {
1569: empilement_pile_systeme(s_etat_processus);
1570:
1571: if ((*s_etat_processus).erreur_systeme != d_es)
1572: {
1573: if (pthread_mutex_unlock(
1574: &((*(*s_etat_processus)
1575: .s_liste_variables_partagees)
1576: .mutex)) != 0)
1577: {
1578: (*s_etat_processus).erreur_systeme =
1579: d_es_processus;
1580: return;
1581: }
1582:
1583: return;
1584: }
1585:
1586: (*(*s_etat_processus).l_base_pile_systeme)
1587: .adresse_retour =
1588: (*s_etat_processus).position_courante;
1589:
1590: (*(*s_etat_processus).l_base_pile_systeme)
1591: .retour_definition = 'Y';
1592: (*(*s_etat_processus).l_base_pile_systeme)
1593: .niveau_courant =
1594: (*s_etat_processus).niveau_courant;
1595:
1596: (*s_etat_processus).position_courante =
1597: (*((unsigned long *)
1598: ((*((*s_etat_processus)
1599: .s_liste_variables[(*s_etat_processus)
1600: .position_variable_courante].objet))
1601: .objet)));
1602:
1603: (*s_etat_processus)
1604: .autorisation_empilement_programme
1605: = 'N';
1606: }
1607: }
1608: else
1609: {
1610: (*s_etat_processus).erreur_systeme = d_es;
1611: }
1612:
1613: if (pthread_mutex_unlock(&((*(*s_etat_processus)
1614: .s_liste_variables_partagees).mutex)) != 0)
1615: {
1616: (*s_etat_processus).erreur_systeme =
1617: d_es_processus;
1618: return;
1619: }
1620: }
1621: else
1622: {
1623: if ((*((*s_etat_processus).s_liste_variables
1624: [(*s_etat_processus)
1625: .position_variable_courante]).objet).type
1626: == ADR)
1627: {
1628: empilement_pile_systeme(s_etat_processus);
1629:
1630: if ((*s_etat_processus).erreur_systeme != d_es)
1631: {
1632: return;
1633: }
1634:
1635: (*(*s_etat_processus).l_base_pile_systeme)
1636: .adresse_retour =
1637: (*s_etat_processus).position_courante;
1638:
1639: (*(*s_etat_processus).l_base_pile_systeme)
1640: .retour_definition = 'Y';
1641: (*(*s_etat_processus).l_base_pile_systeme)
1642: .niveau_courant =
1643: (*s_etat_processus).niveau_courant;
1644:
1645: (*s_etat_processus).position_courante =
1646: (*((unsigned long *) ((*((*s_etat_processus)
1647: .s_liste_variables[(*s_etat_processus)
1648: .position_variable_courante].objet))
1649: .objet)));
1650:
1651: (*s_etat_processus)
1652: .autorisation_empilement_programme
1653: = 'N';
1654: }
1655: }
1656: }
1657: else
1658: {
1659: (*s_etat_processus).erreur_systeme = d_es;
1660: instruction_majuscule = conversion_majuscule(
1661: (*s_etat_processus).instruction_courante);
1662:
1663: if (instruction_majuscule == NULL)
1664: {
1665: return;
1666: }
1667:
1668: /*
1669: * Traitement de la pile système par les
1670: * différentes instructions.
1671: */
1672:
1673: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1674: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1675: (strcmp(instruction_majuscule, "DO") == 0) ||
1676: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1677: (strcmp(instruction_majuscule, "FOR") == 0) ||
1678: (strcmp(instruction_majuscule, "START") == 0) ||
1679: (strcmp(instruction_majuscule, "SELECT") == 0)
1680: || (strcmp(instruction_majuscule, "CASE") == 0)
1681: || (strcmp(instruction_majuscule, "<<") == 0))
1682: {
1683: if (strcmp(instruction_majuscule, "<<") == 0)
1684: {
1685: analyse(s_etat_processus, NULL);
1686: }
1687: else
1688: {
1689: if ((strcmp(instruction_majuscule, "DO") == 0) ||
1690: (strcmp(instruction_majuscule, "WHILE")
1691: == 0))
1692: {
1693: niveau++;
1694: }
1695:
1696: empilement_pile_systeme(s_etat_processus);
1697:
1698: if ((*s_etat_processus).erreur_systeme != d_es)
1699: {
1700: return;
1701: }
1702: }
1703: }
1704: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1705: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1706: (strcmp(instruction_majuscule, "STEP") == 0) ||
1707: (strcmp(instruction_majuscule, ">>") == 0))
1708: {
1709: if (strcmp(instruction_majuscule, ">>") == 0)
1710: {
1711: analyse(s_etat_processus, NULL);
1712:
1713: if ((*s_etat_processus).retour_routine_evaluation
1714: == 'Y')
1715: {
1716: drapeau_presence_fin_boucle = d_faux;
1717: free((*s_etat_processus).instruction_courante);
1718:
1719: break;
1720: }
1721: }
1722: else
1723: {
1724: if (strcmp(instruction_majuscule, "END") == 0)
1725: {
1726: if (((*(*s_etat_processus).l_base_pile_systeme)
1727: .type_cloture == 'D') ||
1728: ((*(*s_etat_processus)
1729: .l_base_pile_systeme).type_cloture
1730: == 'W'))
1731: {
1732: niveau--;
1733: }
1734:
1735: depilement_pile_systeme(s_etat_processus);
1736: }
1737: else
1738: {
1739: depilement_pile_systeme(s_etat_processus);
1740: }
1741:
1742: if ((*s_etat_processus).erreur_systeme != d_es)
1743: {
1744: return;
1745: }
1746: }
1747: }
1748: }
1749:
1750: free((*s_etat_processus).instruction_courante);
1751: }
1752: }
1753:
1754: if (drapeau_presence_fin_boucle == d_faux)
1755: {
1756: (*s_etat_processus).traitement_cycle_exit = 'E';
1757: }
1758: else
1759: {
1760: (*s_etat_processus).traitement_cycle_exit = 'N';
1761: }
1762:
1763: free(instruction_majuscule);
1764: (*s_etat_processus).instruction_courante = tampon;
1765: }
1766: else
1767: {
1768: /* EXIT apparaissant dans l'évaluation d'une expression */
1769:
1770: drapeau_presence_fin_boucle = d_faux;
1771: instruction_majuscule = NULL;
1772: niveau = 1;
1773:
1774: if (drapeau_boucle_definie == d_vrai)
1775: {
1776: while((*s_etat_processus).expression_courante != NULL)
1777: {
1778: while((*(*(*s_etat_processus).expression_courante)
1779: .donnee).type != FCT)
1780: {
1781: if ((*s_etat_processus).expression_courante == NULL)
1782: {
1783: (*s_etat_processus).erreur_execution =
1784: d_ex_erreur_traitement_boucle;
1785: return;
1786: }
1787:
1788: (*s_etat_processus).expression_courante =
1789: (*(*s_etat_processus).expression_courante).suivant;
1790: }
1791:
1792: fonction = (*((struct_fonction *) (*(*(*s_etat_processus)
1793: .expression_courante).donnee).objet)).fonction;
1794:
1795: if ((fonction == instruction_if) ||
1796: (fonction == instruction_iferr) ||
1797: (fonction == instruction_do) ||
1798: (fonction == instruction_while) ||
1799: (fonction == instruction_for) ||
1800: (fonction == instruction_start) ||
1801: (fonction == instruction_select) ||
1802: (fonction == instruction_case) ||
1803: (fonction == instruction_vers_niveau_superieur))
1804: {
1805: if (fonction == instruction_vers_niveau_superieur)
1806: {
1807: analyse(s_etat_processus,
1808: instruction_vers_niveau_superieur);
1809: }
1810: else
1811: {
1812: if ((fonction == instruction_for) ||
1813: (fonction == instruction_start))
1814: {
1815: niveau++;
1816: }
1817:
1818: empilement_pile_systeme(s_etat_processus);
1819:
1820: if ((*s_etat_processus).erreur_systeme != d_es)
1821: {
1822: return;
1823: }
1824: }
1825: }
1826: else if ((fonction == instruction_end) ||
1827: (fonction == instruction_next) ||
1828: (fonction == instruction_step) ||
1829: (fonction == instruction_vers_niveau_inferieur))
1830: {
1831: if (fonction == instruction_vers_niveau_inferieur)
1832: {
1833: tampon = (*s_etat_processus).instruction_courante;
1834: (*s_etat_processus).instruction_courante =
1835: instruction_majuscule;
1836:
1837: analyse(s_etat_processus,
1838: instruction_vers_niveau_inferieur);
1839:
1840: (*s_etat_processus).instruction_courante = tampon;
1841: }
1842: else
1843: {
1844: if ((fonction == instruction_next) ||
1845: (fonction == instruction_step))
1846: {
1847: niveau--;
1848:
1849: if (niveau != 0)
1850: {
1851: depilement_pile_systeme(s_etat_processus);
1852: }
1853: else
1854: {
1855: drapeau_presence_fin_boucle = d_vrai;
1856: break;
1857: }
1858: }
1859: else
1860: {
1861: depilement_pile_systeme(s_etat_processus);
1862: }
1863:
1864: if ((*s_etat_processus).erreur_systeme != d_es)
1865: {
1866: return;
1867: }
1868: }
1869: }
1870:
1871: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
1872: .expression_courante).suivant;
1873: }
1874: }
1875: else
1876: {
1877: while((*s_etat_processus).expression_courante != NULL)
1878: {
1879: while((*(*(*s_etat_processus).expression_courante)
1880: .donnee).type != FCT)
1881: {
1882: if ((*s_etat_processus).expression_courante == NULL)
1883: {
1884: (*s_etat_processus).erreur_execution =
1885: d_ex_erreur_traitement_boucle;
1886: return;
1887: }
1888:
1889: (*s_etat_processus).expression_courante =
1890: (*(*s_etat_processus).expression_courante).suivant;
1891: }
1892:
1893: fonction = (*((struct_fonction *) (*(*(*s_etat_processus)
1894: .expression_courante).donnee).objet)).fonction;
1895:
1896: if ((fonction == instruction_if) ||
1897: (fonction == instruction_iferr) ||
1898: (fonction == instruction_do) ||
1899: (fonction == instruction_while) ||
1900: (fonction == instruction_for) ||
1901: (fonction == instruction_start) ||
1902: (fonction == instruction_select) ||
1903: (fonction == instruction_case) ||
1904: (fonction == instruction_vers_niveau_superieur))
1905: {
1906: if (fonction == instruction_vers_niveau_superieur)
1907: {
1908: analyse(s_etat_processus,
1909: instruction_vers_niveau_superieur);
1910: }
1911: else
1912: {
1913: if ((fonction == instruction_do) ||
1914: (fonction == instruction_while))
1915: {
1916: niveau++;
1917: }
1918:
1919: empilement_pile_systeme(s_etat_processus);
1920:
1921: if ((*s_etat_processus).erreur_systeme != d_es)
1922: {
1923: return;
1924: }
1925: }
1926: }
1927: else if ((fonction == instruction_end) ||
1928: (fonction == instruction_next) ||
1929: (fonction == instruction_step) ||
1930: (fonction == instruction_vers_niveau_inferieur))
1931: {
1932: if (fonction == instruction_vers_niveau_inferieur)
1933: {
1934: analyse(s_etat_processus,
1935: instruction_vers_niveau_inferieur);
1936: }
1937: else
1938: {
1939: if (fonction == instruction_end)
1940: {
1941: if (((*(*s_etat_processus).l_base_pile_systeme)
1942: .type_cloture == 'D') ||
1943: ((*(*s_etat_processus).l_base_pile_systeme)
1944: .type_cloture == 'W'))
1945: {
1946: niveau--;
1947: }
1948:
1949: depilement_pile_systeme(s_etat_processus);
1950:
1951: if (niveau == 0)
1952: {
1953: drapeau_presence_fin_boucle = d_vrai;
1954: break;
1955: }
1956: }
1957: else
1958: {
1959: depilement_pile_systeme(s_etat_processus);
1960: }
1961:
1962: if ((*s_etat_processus).erreur_systeme != d_es)
1963: {
1964: return;
1965: }
1966: }
1967: }
1968:
1969: (*s_etat_processus).expression_courante = (*(*s_etat_processus)
1970: .expression_courante).suivant;
1971: }
1972: }
1973:
1974: if (drapeau_presence_fin_boucle == d_faux)
1975: {
1976: (*s_etat_processus).traitement_cycle_exit = 'E';
1977: }
1978: else
1979: {
1980: (*s_etat_processus).traitement_cycle_exit = 'N';
1981: }
1982: }
1983:
1984: if ((drapeau_boucle_definie == d_vrai) &&
1985: (drapeau_presence_fin_boucle == d_vrai))
1986: {
1987: presence_compteur = ((*(*s_etat_processus).l_base_pile_systeme)
1988: .type_cloture == 'F') ? d_vrai : d_faux;
1989:
1990: if (((*(*s_etat_processus).l_base_pile_systeme).type_cloture != 'S')
1991: && (presence_compteur == d_faux))
1992: {
1993: (*s_etat_processus).erreur_execution =
1994: d_ex_erreur_traitement_boucle;
1995: return;
1996: }
1997:
1998: depilement_pile_systeme(s_etat_processus);
1999:
2000: if ((*s_etat_processus).erreur_systeme != d_es)
2001: {
2002: return;
2003: }
2004:
2005: if (presence_compteur == d_vrai)
2006: {
2007: (*(*s_etat_processus).l_base_pile_systeme).indice_boucle = NULL;
2008: (*s_etat_processus).niveau_courant--;
2009:
2010: if (retrait_variable_par_niveau(s_etat_processus) == d_erreur)
2011: {
2012: return;
2013: }
2014: }
2015: }
2016:
2017: return;
2018: }
2019:
2020: // 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