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