1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.36
4: Copyright (C) 1989-2025 Dr. BERTRAND Joël
5:
6: This file is part of RPL/2.
7:
8: RPL/2 is free software; you can redistribute it and/or modify it
9: under the terms of the CeCILL V2 License as published by the french
10: CEA, CNRS and INRIA.
11:
12: RPL/2 is distributed in the hope that it will be useful, but WITHOUT
13: ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14: FITNESS FOR A PARTICULAR PURPOSE. See the CeCILL V2 License
15: for more details.
16:
17: You should have received a copy of the CeCILL License
18: along with RPL/2. If not, write to info@cecill.info.
19: ================================================================================
20: */
21:
22:
23: #include "rpl-conv.h"
24:
25:
26: /*
27: ================================================================================
28: Boucle principale de l'interprète RPL/2
29: ================================================================================
30: Entrées : structure sur l'état du processus
31: --------------------------------------------------------------------------------
32: Sorties : néant
33: --------------------------------------------------------------------------------
34: Effets de bord : néant
35: ================================================================================
36: */
37:
38: logical1
39: sequenceur(struct_processus *s_etat_processus)
40: {
41: struct_liste_chainee *l_element_courant;
42:
43: struct_objet *s_objet;
44: struct_objet *s_objet_evaluation;
45: struct_objet *s_sous_objet;
46:
47: integer8 niveau;
48: integer8 position_courante;
49:
50: logical1 drapeau_appel_definition;
51: logical1 drapeau_fin;
52: logical1 drapeau_then;
53: logical1 erreur;
54: logical1 presence_compteur;
55:
56: static logical1 completion_valide = d_faux;
57:
58: struct sigaction action;
59: struct sigaction action_defaut;
60: struct sigaction action_defaut2;
61:
62: unsigned char *instruction_majuscule;
63: unsigned char *ligne;
64: unsigned char *message;
65: unsigned char *registre;
66: unsigned char *tampon;
67: unsigned char *t_ligne;
68:
69: Keymap ancien_keymap;
70: Keymap nouveau_keymap;
71:
72: (*s_etat_processus).retour_routine_evaluation = 'N';
73:
74: if ((*s_etat_processus).debug == d_vrai)
75: if (((*s_etat_processus).type_debug &
76: d_debug_appels_fonctions) != 0)
77: {
78: if ((*s_etat_processus).niveau_recursivite != 0)
79: {
80: if ((*s_etat_processus).langue == 'F')
81: {
82: printf("[%d] Exécution récursive de niveau %lld\n",
83: (int) getpid(), (*s_etat_processus).niveau_recursivite);
84: }
85: else
86: {
87: printf("[%d] %lld level recursive execution\n",
88: (int) getpid(), (*s_etat_processus).niveau_recursivite);
89: }
90: }
91: else
92: {
93: if ((*s_etat_processus).langue == 'F')
94: {
95: printf("[%d] Exécution\n", (int) getpid());
96: }
97: else
98: {
99: printf("[%d] Execution\n", (int) getpid());
100: }
101: }
102:
103: fflush(stdout);
104: }
105:
106: /*
107: --------------------------------------------------------------------------------
108: Boucle de l'interprète RPL/2
109: On boucle tant qu'on n'a pas une bonne raison de sortir...
110: --------------------------------------------------------------------------------
111: */
112:
113: do
114: {
115: drapeau_appel_definition = d_faux;
116:
117: /*
118: --------------------------------------------------------------------------------
119: Recherche de l'instruction suivante dans les définitions chaînées
120: --------------------------------------------------------------------------------
121: */
122:
123: if ((erreur = recherche_instruction_suivante(s_etat_processus))
124: == d_erreur)
125: {
126: return(d_erreur);
127: }
128:
129: if (((*s_etat_processus).debug_programme == d_vrai) &&
130: ((*s_etat_processus).niveau_recursivite == 0))
131: {
132: /*
133: * Traitement de la commande HALT (debug)
134: */
135:
136: action.sa_handler = SIG_IGN;
137: action.sa_flags = 0;
138:
139: (*s_etat_processus).execution_pas_suivant = d_faux;
140: (*s_etat_processus).traitement_instruction_halt = d_vrai;
141:
142: if (completion_valide == d_faux)
143: {
144: initialisation_completion();
145: completion_valide = d_vrai;
146: }
147:
148: while((*s_etat_processus).execution_pas_suivant == d_faux)
149: {
150: if ((*s_etat_processus).hauteur_pile_operationnelle != 0)
151: {
152: fprintf(stdout, "\n");
153: }
154:
155: affichage_pile(s_etat_processus, (*s_etat_processus)
156: .l_base_pile, 1);
157:
158: if ((*s_etat_processus).mode_interactif == 'N')
159: {
160: printf("[%d] Instruction : %s\n", (int) getpid(),
161: (*s_etat_processus).instruction_courante);
162: fflush(stdout);
163: }
164:
165: if (pthread_mutex_lock(&mutex_sigaction) != 0)
166: {
167: (*s_etat_processus).erreur_systeme = d_es_processus;
168: return(d_erreur);
169: }
170:
171: if (sigaction(SIGINT, &action, &action_defaut) != 0)
172: {
173: pthread_mutex_unlock(&mutex_sigaction);
174: (*s_etat_processus).erreur_systeme = d_es_signal;
175: return(d_erreur);
176: }
177:
178: if (sigaction(SIGTSTP, &action, &action_defaut2) != 0)
179: {
180: pthread_mutex_unlock(&mutex_sigaction);
181: (*s_etat_processus).erreur_systeme = d_es_signal;
182: return(d_erreur);
183: }
184:
185: (*s_etat_processus).var_volatile_requete_arret = 0;
186: (*s_etat_processus).var_volatile_requete_arret2 = 0;
187:
188: flockfile(stdin);
189: flockfile(stdout);
190:
191: ancien_keymap = rl_get_keymap();
192: nouveau_keymap = rl_copy_keymap(ancien_keymap);
193: rl_set_keymap(nouveau_keymap);
194:
195: rl_bind_key(NEWLINE, readline_analyse_syntaxique);
196: rl_bind_key(RETURN, readline_analyse_syntaxique);
197: rl_bind_key(CTRL('g'), readline_effacement);
198: rl_done = 0;
199:
200: ligne = readline("RPL/2> ");
201:
202: rl_set_keymap(ancien_keymap);
203: rl_free(nouveau_keymap);
204:
205: funlockfile(stdin);
206: funlockfile(stdout);
207:
208: if (ligne != NULL)
209: {
210: if ((t_ligne = transliteration(s_etat_processus, ligne,
211: (*s_etat_processus).localisation, d_locale))
212: == NULL)
213: {
214: pthread_mutex_unlock(&mutex_sigaction);
215: free((*s_etat_processus).instruction_courante);
216: return(d_erreur);
217: }
218:
219: free(ligne);
220: ligne = t_ligne;
221:
222: if ((ligne = compactage(s_etat_processus, ligne)) == NULL)
223: {
224: pthread_mutex_unlock(&mutex_sigaction);
225: (*s_etat_processus).erreur_systeme =
226: d_es_allocation_memoire;
227: return(d_erreur);
228: }
229: }
230:
231: if (sigaction(SIGINT, &action_defaut, NULL) != 0)
232: {
233: pthread_mutex_unlock(&mutex_sigaction);
234: (*s_etat_processus).erreur_systeme = d_es_signal;
235: return(d_erreur);
236: }
237:
238: if (sigaction(SIGTSTP, &action_defaut2, NULL) != 0)
239: {
240: pthread_mutex_unlock(&mutex_sigaction);
241: (*s_etat_processus).erreur_systeme = d_es_signal;
242: return(d_erreur);
243: }
244:
245: if (pthread_mutex_unlock(&mutex_sigaction) != 0)
246: {
247: (*s_etat_processus).erreur_systeme = d_es_processus;
248: return(d_erreur);
249: }
250:
251: if (ligne == NULL)
252: {
253: if ((ligne = (unsigned char *) malloc(6 *
254: sizeof(unsigned char))) == NULL)
255: {
256: (*s_etat_processus).erreur_systeme =
257: d_es_allocation_memoire;
258: return(d_erreur);
259: }
260:
261: sprintf(ligne, "abort");
262: fprintf(stdout, "%s\n", ligne);
263: }
264: else if (((*ligne) == d_code_fin_chaine) &&
265: ((*s_etat_processus).l_base_pile != NULL))
266: {
267: free(ligne);
268:
269: if ((ligne = (unsigned char *) malloc(4 *
270: sizeof(unsigned char))) == NULL)
271: {
272: (*s_etat_processus).erreur_systeme =
273: d_es_allocation_memoire;
274: return(d_erreur);
275: }
276:
277: sprintf(ligne, "dup");
278: }
279:
280: if ((*s_etat_processus).var_volatile_requete_arret != 0)
281: {
282: free(ligne);
283: (*s_etat_processus).requete_arret = 'Y';
284: break;
285: }
286:
287: add_history(ligne);
288: stifle_history(ds_longueur_historique);
289:
290: position_courante = (*s_etat_processus).position_courante;
291: tampon = (*s_etat_processus).definitions_chainees;
292: registre = (*s_etat_processus).instruction_courante;
293: (*s_etat_processus).definitions_chainees = ligne;
294:
295: if (analyse_syntaxique(s_etat_processus) == d_absence_erreur)
296: {
297: (*s_etat_processus).instruction_courante = registre;
298: (*s_etat_processus).position_courante = position_courante;
299: (*s_etat_processus).definitions_chainees = tampon;
300:
301: if ((tampon = (unsigned char *) malloc((strlen(ligne) + 7) *
302: sizeof(unsigned char))) == NULL)
303: {
304: (*s_etat_processus).erreur_systeme =
305: d_es_allocation_memoire;
306: return(d_erreur);
307: }
308:
309: sprintf(tampon, "<< %s >>", ligne);
310:
311: free(ligne);
312: ligne = tampon;
313:
314: tampon = (*s_etat_processus).instruction_courante;
315: (*s_etat_processus).instruction_courante = ligne;
316:
317: (*s_etat_processus).type_en_cours = NON;
318: recherche_type(s_etat_processus);
319:
320: (*s_etat_processus).instruction_courante = tampon;
321:
322: if ((((*s_etat_processus).erreur_execution != d_ex) ||
323: ((*s_etat_processus).erreur_systeme != d_es)) &&
324: ((*s_etat_processus).invalidation_message_erreur
325: == d_faux))
326: {
327: if ((*s_etat_processus).erreur_execution != d_ex)
328: {
329: (*s_etat_processus).erreur_scrutation = d_vrai;
330: }
331:
332: if (test_cfsf(s_etat_processus, 51) == d_faux)
333: {
334: printf("%s", ds_beep);
335: }
336:
337: if ((message = messages(s_etat_processus)) == NULL)
338: {
339: free((*s_etat_processus).instruction_courante);
340: return(d_erreur);
341: }
342:
343: printf("%s [%d]\n", message, (int) getpid());
344:
345: free(message);
346:
347: (*s_etat_processus).erreur_execution = d_ex;
348:
349: if ((*s_etat_processus).erreur_systeme != d_es)
350: {
351: return(d_erreur);
352: }
353: }
354: else
355: {
356: position_courante =
357: (*s_etat_processus).position_courante;
358: empilement_pile_systeme(s_etat_processus);
359:
360: if ((*s_etat_processus).erreur_systeme != d_es)
361: {
362: return(d_erreur);
363: }
364:
365: (*(*s_etat_processus).l_base_pile_systeme)
366: .retour_definition = 'Y';
367:
368: if (depilement(s_etat_processus, &((*s_etat_processus)
369: .l_base_pile), &s_objet) == d_erreur)
370: {
371: if (test_cfsf(s_etat_processus, 51) == d_faux)
372: {
373: printf("%s", ds_beep);
374: }
375:
376: if ((*s_etat_processus).langue == 'F')
377: {
378: printf("+++Erreur : Défaut d'argument\n");
379: }
380: else
381: {
382: printf("+++Error : Too few arguments\n");
383: }
384:
385: depilement_pile_systeme(s_etat_processus);
386:
387: if ((*s_etat_processus).erreur_systeme != d_es)
388: {
389: return(d_erreur);
390: }
391:
392: fflush(stdout);
393: }
394: else if (evaluation(s_etat_processus, s_objet, 'I') ==
395: d_erreur)
396: {
397: if ((*s_etat_processus).erreur_systeme != d_es)
398: {
399: if (test_cfsf(s_etat_processus, 51) == d_faux)
400: {
401: printf("%s", ds_beep);
402: }
403:
404: if ((message = messages(s_etat_processus))
405: == NULL)
406: {
407: free((*s_etat_processus)
408: .instruction_courante);
409: return(d_erreur);
410: }
411:
412: printf("%s [%d]\n", message, (int) getpid());
413:
414: free(message);
415: free((*s_etat_processus).instruction_courante);
416: return(d_erreur);
417: }
418: else if ((*s_etat_processus)
419: .invalidation_message_erreur == d_faux)
420: {
421: (*s_etat_processus).erreur_execution =
422: (*s_etat_processus)
423: .derniere_erreur_evaluation;
424:
425: if (test_cfsf(s_etat_processus, 51) == d_faux)
426: {
427: printf("%s", ds_beep);
428: }
429:
430: if ((message = messages(s_etat_processus))
431: == NULL)
432: {
433: free((*s_etat_processus)
434: .instruction_courante);
435: return(d_erreur);
436: }
437:
438: printf("%s [%d]\n", message, (int) getpid());
439: free(message);
440:
441: if (test_cfsf(s_etat_processus, 31) == d_vrai)
442: {
443: l_element_courant = (*s_etat_processus)
444: .l_base_pile_last;
445:
446: while(l_element_courant != NULL)
447: {
448: if ((s_sous_objet = copie_objet(
449: s_etat_processus,
450: (*l_element_courant).donnee,
451: 'P')) == NULL)
452: {
453: (*s_etat_processus).erreur_systeme =
454: d_es_allocation_memoire;
455: return(d_erreur);
456: }
457:
458: if (empilement(s_etat_processus,
459: &((*s_etat_processus)
460: .l_base_pile),
461: s_sous_objet) == d_erreur)
462: {
463: return(d_erreur);
464: }
465:
466: l_element_courant = (*l_element_courant)
467: .suivant;
468: }
469: }
470:
471: (*s_etat_processus).erreur_execution = d_ex;
472: (*s_etat_processus).exception = d_ep;
473: }
474:
475: liberation(s_etat_processus, s_objet);
476: }
477: else
478: {
479: liberation(s_etat_processus, s_objet);
480: }
481:
482: (*s_etat_processus).position_courante =
483: position_courante;
484: }
485: }
486: else if ((*s_etat_processus).invalidation_message_erreur
487: == d_faux)
488: {
489: (*s_etat_processus).instruction_courante = registre;
490: (*s_etat_processus).position_courante = position_courante;
491: (*s_etat_processus).definitions_chainees = tampon;
492:
493: if (test_cfsf(s_etat_processus, 51) == d_faux)
494: {
495: printf("%s", ds_beep);
496: }
497:
498: if ((message = messages(s_etat_processus)) == NULL)
499: {
500: free((*s_etat_processus).instruction_courante);
501: free(ligne);
502: return(d_erreur);
503: }
504:
505: free(message);
506:
507: if ((*s_etat_processus).langue == 'F')
508: {
509: printf("+++Erreur : Erreur de syntaxe\n");
510: }
511: else
512: {
513: printf("+++Error : Syntax error\n");
514: }
515:
516: fflush(stdout);
517: }
518:
519: free(ligne);
520: }
521:
522: (*s_etat_processus).traitement_instruction_halt = d_faux;
523: }
524:
525: if ((*s_etat_processus).debug == d_vrai)
526: if (((*s_etat_processus).type_debug &
527: d_debug_fonctions_intrinseques) != 0)
528: {
529: if ((*s_etat_processus).langue == 'F')
530: {
531: printf("[%d] Instruction %s\n",
532: (int) getpid(),
533: (*s_etat_processus).instruction_courante);
534: }
535: else
536: {
537: printf("[%d] %s instruction\n",
538: (int) getpid(),
539: (*s_etat_processus).instruction_courante);
540: }
541:
542: fflush(stdout);
543: }
544:
545: /*
546: --------------------------------------------------------------------------------
547: Dans le cas où une instruction est retournée, celle-ci est évaluée. Dans le
548: cas contraire, l'interprète renvoie un message d'erreur et s'interrompt.
549: --------------------------------------------------------------------------------
550: */
551:
552: if (erreur == d_absence_erreur)
553: {
554:
555: /*
556: --------------------------------------------------------------------------------
557: Scrutation des mots clef du langage RPL/2 et exécution le cas échéant
558: de l'action associée.
559: --------------------------------------------------------------------------------
560: */
561:
562: (*s_etat_processus).instruction_sensible = 'N';
563:
564: analyse(s_etat_processus, NULL);
565:
566: if ((*s_etat_processus).traitement_cycle_exit != 'N')
567: {
568: switch((*s_etat_processus).traitement_cycle_exit)
569: {
570: case 'C' :
571: {
572: instruction_cycle(s_etat_processus);
573: break;
574: }
575:
576: case 'E' :
577: {
578: instruction_exit(s_etat_processus);
579: break;
580: }
581: }
582: }
583:
584: if ((*s_etat_processus).instruction_valide == 'N')
585: {
586:
587: /*
588: --------------------------------------------------------------------------------
589: L'instruction ne correspond pas à l'un des mots clef du langage RPL/2.
590: --------------------------------------------------------------------------------
591: */
592:
593: if ((recherche_variable(s_etat_processus,
594: (*s_etat_processus).instruction_courante) ==
595: d_vrai) && ((*s_etat_processus)
596: .autorisation_evaluation_nom == 'Y'))
597: {
598: if ((*(*s_etat_processus).pointeur_variable_courante)
599: .objet == NULL)
600: {
601:
602: /*
603: --------------------------------------------------------------------------------
604: L'instruction est une variable partagée
605: --------------------------------------------------------------------------------
606: */
607:
608: if (recherche_variable_partagee(s_etat_processus,
609: (*(*s_etat_processus)
610: .pointeur_variable_courante).nom,
611: (*(*s_etat_processus)
612: .pointeur_variable_courante).variable_partagee,
613: 'P') != NULL)
614: {
615: // La variable existe.
616:
617: if ((*s_etat_processus).debug == d_vrai)
618: if (((*s_etat_processus).type_debug &
619: d_debug_variables) != 0)
620: {
621: if ((*s_etat_processus).langue == 'F')
622: {
623: printf("[%d] Évaluation de la variable "
624: "partagée %s de type %d\n",
625: (int) getpid(), (*s_etat_processus)
626: .instruction_courante,
627: (*(*(*s_etat_processus)
628: .pointeur_variable_partagee_courante)
629: .objet).type);
630: }
631: else
632: {
633: printf("[%d] Pushing %s as %d type shared "
634: "variable\n", (int) getpid(),
635: (*s_etat_processus)
636: .instruction_courante,
637: (*(*(*s_etat_processus)
638: .pointeur_variable_partagee_courante)
639: .objet).type);
640: }
641:
642: fflush(stdout);
643: }
644:
645: if ((s_objet = copie_objet(s_etat_processus,
646: (*(*s_etat_processus)
647: .pointeur_variable_partagee_courante)
648: .objet, 'P')) == NULL)
649: {
650: (*s_etat_processus).erreur_systeme =
651: d_es_allocation_memoire;
652: return(d_erreur);
653: }
654:
655: if (pthread_mutex_unlock(&((*(*s_etat_processus)
656: .pointeur_variable_partagee_courante)
657: .mutex)) != 0)
658: {
659: (*s_etat_processus).erreur_systeme =
660: d_es_processus;
661: return(d_erreur);
662: }
663:
664: if (evaluation(s_etat_processus, s_objet, 'E')
665: == d_erreur)
666: {
667: liberation(s_etat_processus, s_objet);
668: return(d_erreur);
669: }
670:
671: liberation(s_etat_processus, s_objet);
672: }
673: else
674: {
675: // La variable n'existe plus.
676: if ((*s_etat_processus).debug == d_vrai)
677: if (((*s_etat_processus).type_debug &
678: d_debug_variables) != 0)
679: {
680: if ((*s_etat_processus).langue == 'F')
681: {
682: printf("[%d] Tentative d'accès à la "
683: "variable partagée non définie %s\n",
684: (int) getpid(), (*s_etat_processus)
685: .instruction_courante);
686: }
687: else
688: {
689: printf("[%d] Trying to access to undefined "
690: "shared variable %s\n",
691: (int) getpid(),
692: (*s_etat_processus)
693: .instruction_courante);
694: }
695:
696: fflush(stdout);
697: }
698: }
699: }
700:
701: /*
702: --------------------------------------------------------------------------------
703: L'instruction est une variable automatique (évaluation lors de l'empilement).
704: --------------------------------------------------------------------------------
705: */
706:
707: else if ((*(*(*s_etat_processus).pointeur_variable_courante)
708: .objet).type == ADR)
709: {
710:
711: /*
712: --------------------------------------------------------------------------------
713: L'instruction est une variable de type 'adresse' pointant sur une
714: définition. Un branchement est effectué à cette adresse.
715: --------------------------------------------------------------------------------
716: */
717:
718: if ((*s_etat_processus).debug == d_vrai)
719: if (((*s_etat_processus).type_debug &
720: d_debug_appels_fonctions) != 0)
721: {
722: if ((*s_etat_processus).langue == 'F')
723: {
724: printf("[%d] Branchement à la"
725: " définition %s\n", (int) getpid(),
726: (*s_etat_processus)
727: .instruction_courante);
728: }
729: else
730: {
731: printf("[%d] Execution : "
732: "Branching at %s definition\n",
733: (int) getpid(), (*s_etat_processus)
734: .instruction_courante);
735: }
736:
737: fflush(stdout);
738: }
739:
740: (*s_etat_processus).autorisation_empilement_programme =
741: 'N';
742:
743: empilement_pile_systeme(s_etat_processus);
744:
745: if ((*s_etat_processus).erreur_systeme != d_es)
746: {
747: erreur = d_erreur;
748: }
749: else
750: {
751: if ((*s_etat_processus).profilage == d_vrai)
752: {
753: profilage(s_etat_processus,
754: (*s_etat_processus)
755: .instruction_courante);
756:
757: if ((*s_etat_processus).erreur_systeme != d_es)
758: {
759: return(d_erreur);
760: }
761: }
762:
763: (*s_etat_processus).debug_programme = d_faux;
764:
765: (*(*s_etat_processus).l_base_pile_systeme)
766: .adresse_retour = (*s_etat_processus)
767: .position_courante;
768:
769: (*(*s_etat_processus).l_base_pile_systeme)
770: .retour_definition = 'Y';
771:
772: (*(*s_etat_processus).l_base_pile_systeme)
773: .niveau_courant = (*s_etat_processus)
774: .niveau_courant;
775:
776: (*s_etat_processus).position_courante =
777: (*((integer8 *)
778: ((*(*(*s_etat_processus)
779: .pointeur_variable_courante)
780: .objet).objet)));
781:
782: drapeau_appel_definition = d_vrai;
783: }
784: }
785: else
786: {
787: if ((*s_etat_processus).debug == d_vrai)
788: if (((*s_etat_processus).type_debug &
789: d_debug_variables) != 0)
790: {
791: if ((*s_etat_processus).langue == 'F')
792: {
793: printf("[%d] Évaluation de la variable "
794: "%s de type %d\n",
795: (int) getpid(),
796: (*s_etat_processus)
797: .instruction_courante,
798: (*(*(*s_etat_processus)
799: .pointeur_variable_courante).objet)
800: .type);
801: }
802: else
803: {
804: printf("[%d] Pushing %s as %d type variable "
805: "\n", (int) getpid(),
806: (*s_etat_processus)
807: .instruction_courante,
808: (*(*(*s_etat_processus)
809: .pointeur_variable_courante).objet)
810: .type);
811: }
812:
813: fflush(stdout);
814: }
815:
816: if ((s_objet = copie_objet(s_etat_processus,
817: (*(*s_etat_processus)
818: .pointeur_variable_courante).objet, 'P'))
819: == NULL)
820: {
821: (*s_etat_processus).erreur_systeme =
822: d_es_allocation_memoire;
823: return(d_erreur);
824: }
825:
826: if (evaluation(s_etat_processus, s_objet, 'E')
827: == d_erreur)
828: {
829: liberation(s_etat_processus, s_objet);
830: return(d_erreur);
831: }
832:
833: liberation(s_etat_processus, s_objet);
834: }
835: }
836: else
837: {
838:
839: /*
840: --------------------------------------------------------------------------------
841: L'instruction est une donnée à empiler.
842: --------------------------------------------------------------------------------
843: */
844:
845: (*s_etat_processus).erreur_systeme = d_es;
846: (*s_etat_processus).type_en_cours = NON;
847: recherche_type(s_etat_processus);
848:
849: if ((*s_etat_processus).autorisation_nom_implicite == 'N')
850: {
851: if ((*s_etat_processus).l_base_pile == NULL)
852: {
853: if (((*s_etat_processus).erreur_execution !=
854: d_ex_nom_implicite) &&
855: ((*s_etat_processus).erreur_execution !=
856: d_ex_syntaxe))
857: {
858: (*s_etat_processus).erreur_execution =
859: d_ex_manque_argument;
860: }
861: }
862: else if ((*(*(*s_etat_processus).l_base_pile).donnee)
863: .type == NOM)
864: {
865: if ((*((struct_nom *) (*(*(*s_etat_processus)
866: .l_base_pile).donnee).objet)).symbole
867: == d_faux)
868: {
869: (*s_etat_processus).erreur_execution =
870: d_ex_nom_implicite;
871:
872: // Si le niveau de récursivité est non nul, on
873: // arrive ici depuis la fonction
874: // recherche_type(). On retourne à cette
875: // dernière en indiquant une erreur.
876:
877: if ((*s_etat_processus).niveau_recursivite != 0)
878: {
879: free((*s_etat_processus)
880: .instruction_courante);
881: return(d_erreur);
882: }
883: }
884: }
885: }
886:
887: // Le séquenceur est appelé depuis la routine d'évaluation
888:
889: if ((*s_etat_processus).evaluation_forcee == 'Y')
890: {
891: if (depilement(s_etat_processus,
892: &((*s_etat_processus).l_base_pile),
893: &s_objet_evaluation) == d_erreur)
894: {
895: free((*s_etat_processus).instruction_courante);
896: (*s_etat_processus).erreur_execution =
897: d_ex_manque_argument;
898: return(d_erreur);
899: }
900:
901: if (evaluation(s_etat_processus, s_objet_evaluation,
902: 'N') == d_erreur)
903: {
904: free((*s_etat_processus).instruction_courante);
905: liberation(s_etat_processus, s_objet_evaluation);
906: return(d_erreur);
907: }
908:
909: liberation(s_etat_processus, s_objet_evaluation);
910: }
911:
912: // Le séquenceur est appelé depuis la routine de
913: // recherche de type
914:
915: else if ((*s_etat_processus).recherche_type == 'Y')
916: {
917: if ((*s_etat_processus).erreur_execution != d_ex)
918: {
919: free((*s_etat_processus).instruction_courante);
920: return(d_erreur);
921: }
922: }
923: }
924: }
925: else if (((*s_etat_processus).test_instruction == 'Y') &&
926: ((*s_etat_processus).instruction_valide == 'Y'))
927: {
928:
929: /*
930: --------------------------------------------------------------------------------
931: Permet de traiter les fonctions dans les objets de type liste
932: --------------------------------------------------------------------------------
933: */
934:
935: if ((instruction_majuscule = conversion_majuscule(
936: s_etat_processus, (*s_etat_processus)
937: .instruction_courante)) == NULL)
938: {
939: (*s_etat_processus).erreur_systeme =
940: d_es_allocation_memoire;
941: return(d_erreur);
942: }
943:
944: if ((strcmp((*s_etat_processus).instruction_courante, "<<")
945: != 0) && (strcmp((*s_etat_processus)
946: .instruction_courante, ">>") != 0))
947: {
948: if ((s_objet = allocation(s_etat_processus, FCT)) == NULL)
949: {
950: (*s_etat_processus).erreur_systeme =
951: d_es_allocation_memoire;
952: return(d_erreur);
953: }
954:
955: (*((struct_fonction *) (*s_objet).objet))
956: .nombre_arguments = 0;
957:
958: if (((*s_etat_processus).instruction_intrinseque == 'Y') &&
959: ((*s_etat_processus).instruction_sensible == 'N'))
960: {
961: if (((*((struct_fonction *) (*s_objet).objet))
962: .nom_fonction = conversion_majuscule(
963: s_etat_processus, (*s_etat_processus)
964: .instruction_courante)) == NULL)
965: {
966: (*s_etat_processus).erreur_systeme =
967: d_es_allocation_memoire;
968: return(d_erreur);
969: }
970: }
971: else
972: {
973: if (((*((struct_fonction *) (*s_objet).objet))
974: .nom_fonction = (unsigned char *) malloc(
975: (strlen((*s_etat_processus)
976: .instruction_courante)
977: + 1) * sizeof(unsigned char))) == NULL)
978: {
979: (*s_etat_processus).erreur_systeme =
980: d_es_allocation_memoire;
981: return(d_erreur);
982: }
983:
984: strcpy((*((struct_fonction *) (*s_objet).objet))
985: .nom_fonction, (*s_etat_processus)
986: .instruction_courante);
987: }
988:
989: (*((struct_fonction *) (*s_objet).objet)).fonction =
990: analyse_instruction(s_etat_processus,
991: (*s_etat_processus).instruction_courante);
992:
993: if (empilement(s_etat_processus,
994: &((*s_etat_processus).l_base_pile), s_objet) ==
995: d_erreur)
996: {
997: (*s_etat_processus).erreur_systeme =
998: d_es_allocation_memoire;
999: return(d_erreur);
1000: }
1001: }
1002: else
1003: {
1004: (*s_etat_processus).test_instruction = 'N';
1005: analyse(s_etat_processus, NULL);
1006: (*s_etat_processus).test_instruction = 'Y';
1007: }
1008:
1009: free(instruction_majuscule);
1010: }
1011:
1012: erreur = (logical1) (erreur | (((*s_etat_processus)
1013: .erreur_execution != d_ex) ? d_erreur : d_absence_erreur));
1014: }
1015: else
1016: {
1017: printf("\n");
1018:
1019: if ((*s_etat_processus).langue == 'F')
1020: {
1021: printf("+++Erreur : Argument %s invalide\n",
1022: (*s_etat_processus).instruction_courante);
1023: }
1024: else
1025: {
1026: printf("+++Error : Invalid %s argument\n",
1027: (*s_etat_processus).instruction_courante);
1028: }
1029:
1030: fflush(stdout);
1031:
1032: free((*s_etat_processus).instruction_courante);
1033: return(d_erreur);
1034: }
1035:
1036: /*
1037: --------------------------------------------------------------------------------
1038: Traitement des arrêts simples
1039: --------------------------------------------------------------------------------
1040: */
1041:
1042: if ((*s_etat_processus).var_volatile_requete_arret2 != 0)
1043: {
1044: if ((*s_etat_processus).debug_programme == d_vrai)
1045: {
1046: (*s_etat_processus).var_volatile_requete_arret2 = 0;
1047: }
1048: else
1049: {
1050: if ((*s_etat_processus).var_volatile_requete_arret2 == -1)
1051: {
1052: if (strncmp(getenv("LANG"), "fr", 2) == 0)
1053: {
1054: printf("[%d] Arrêt\n", (int) getpid());
1055: }
1056: else
1057: {
1058: printf("[%d] Break\n", (int) getpid());
1059: }
1060:
1061: (*s_etat_processus).var_volatile_requete_arret2 = 1;
1062:
1063: fflush(stdout);
1064: }
1065:
1066: if ((*s_etat_processus).niveau_recursivite == 0)
1067: {
1068: (*s_etat_processus).debug_programme = d_vrai;
1069: (*s_etat_processus).var_volatile_requete_arret2 = 0;
1070: }
1071: }
1072: }
1073:
1074: /*
1075: * On ne sort pas du debugger en cas d'une erreur sur un programme
1076: * en cours de débogage.
1077: */
1078:
1079: if ((((*s_etat_processus).erreur_execution != d_ex) ||
1080: ((*s_etat_processus).exception != d_ep)) &&
1081: ((*s_etat_processus).debug_programme == d_vrai))
1082: {
1083: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1084: {
1085: l_element_courant = (*s_etat_processus).l_base_pile_last;
1086:
1087: while(l_element_courant != NULL)
1088: {
1089: if ((s_objet = copie_objet(s_etat_processus,
1090: (*l_element_courant).donnee, 'P')) == NULL)
1091: {
1092: (*s_etat_processus).erreur_systeme =
1093: d_es_allocation_memoire;
1094: return(d_erreur);
1095: }
1096:
1097: if (empilement(s_etat_processus, &((*s_etat_processus)
1098: .l_base_pile), s_objet) == d_erreur)
1099: {
1100: return(d_erreur);
1101: }
1102:
1103: l_element_courant = (*l_element_courant).suivant;
1104: }
1105: }
1106:
1107: if (test_cfsf(s_etat_processus, 51) == d_faux)
1108: {
1109: printf("%s", ds_beep);
1110: }
1111:
1112: if ((message = messages(s_etat_processus)) == NULL)
1113: {
1114: free((*s_etat_processus).instruction_courante);
1115: return(d_erreur);
1116: }
1117:
1118: printf("%s [%d]\n", message, (int) getpid());
1119:
1120: free(message);
1121:
1122: (*s_etat_processus).erreur_execution = d_ex;
1123: (*s_etat_processus).exception = d_ep;
1124: erreur = d_absence_erreur;
1125:
1126: (*s_etat_processus).position_courante -= (integer8)
1127: strlen((*s_etat_processus).instruction_courante);
1128: }
1129:
1130: /*
1131: --------------------------------------------------------------------------------
1132: Test de fin d'exécution du programme RPL/2
1133: --------------------------------------------------------------------------------
1134: */
1135:
1136: if (((*s_etat_processus).niveau_courant == 0) &&
1137: (drapeau_appel_definition != d_vrai))
1138: {
1139: drapeau_fin = d_vrai;
1140: }
1141: else if ((*s_etat_processus).requete_arret == 'Y')
1142: {
1143: drapeau_fin = d_vrai;
1144: }
1145: else if (((*s_etat_processus).var_volatile_requete_arret != 0)
1146: && ((*s_etat_processus).debug_programme == d_faux))
1147: {
1148: drapeau_fin = d_vrai;
1149:
1150: if ((*s_etat_processus).erreur_systeme == d_es)
1151: {
1152: erreur = d_absence_erreur;
1153: }
1154: }
1155: else if ((*s_etat_processus).arret_si_exception == d_vrai)
1156: {
1157: drapeau_fin = d_faux;
1158:
1159: if ((*s_etat_processus).exception != d_ep)
1160: {
1161: erreur = d_erreur;
1162: }
1163: else if ((*s_etat_processus).erreur_systeme != d_es)
1164: {
1165: erreur = d_erreur;
1166: }
1167: }
1168: else if ((*s_etat_processus).arret_si_exception == d_faux)
1169: {
1170: if ((message = messages(s_etat_processus)) == NULL)
1171: {
1172: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1173: return(d_erreur);
1174: }
1175:
1176: free(message);
1177:
1178: drapeau_fin = d_faux;
1179:
1180: /*
1181: --------------------------------------------------------------------------------
1182: Traitement des exceptions
1183: --------------------------------------------------------------------------------
1184: */
1185:
1186: if ((*s_etat_processus).erreur_systeme != d_es)
1187: {
1188: erreur = d_erreur;
1189: }
1190: else if (((*s_etat_processus).exception != d_ep) ||
1191: ((*s_etat_processus).erreur_execution != d_ex))
1192: {
1193: tampon = (*s_etat_processus).instruction_courante;
1194:
1195: while((*(*s_etat_processus).l_base_pile_systeme).clause != 'R')
1196: {
1197: erreur = recherche_instruction_suivante(s_etat_processus);
1198:
1199: if (erreur == d_erreur)
1200: {
1201: free((*s_etat_processus).instruction_courante);
1202: return(d_erreur);
1203: }
1204:
1205: if (recherche_variable(s_etat_processus,
1206: (*s_etat_processus).instruction_courante) == d_vrai)
1207: {
1208: if ((*(*s_etat_processus).pointeur_variable_courante)
1209: .objet == NULL)
1210: {
1211: // Variable partagée
1212: }
1213: else if ((*(*(*s_etat_processus)
1214: .pointeur_variable_courante).objet).type == ADR)
1215: {
1216: empilement_pile_systeme(s_etat_processus);
1217:
1218: if ((*s_etat_processus).erreur_systeme != d_es)
1219: {
1220: free((*s_etat_processus).instruction_courante);
1221: return(d_erreur);
1222: }
1223:
1224: (*(*s_etat_processus).l_base_pile_systeme)
1225: .adresse_retour = (*s_etat_processus)
1226: .position_courante;
1227:
1228: (*(*s_etat_processus).l_base_pile_systeme)
1229: .retour_definition = 'Y';
1230:
1231: (*(*s_etat_processus).l_base_pile_systeme)
1232: .niveau_courant = (*s_etat_processus)
1233: .niveau_courant;
1234:
1235: (*s_etat_processus).position_courante =
1236: (*((integer8 *)
1237: ((*(*(*s_etat_processus)
1238: .pointeur_variable_courante)
1239: .objet).objet)));
1240:
1241: (*s_etat_processus)
1242: .autorisation_empilement_programme = 'N';
1243: }
1244: }
1245: else
1246: {
1247: (*s_etat_processus).erreur_systeme = d_es;
1248: instruction_majuscule = conversion_majuscule(
1249: s_etat_processus, (*s_etat_processus)
1250: .instruction_courante);
1251:
1252: if (instruction_majuscule == NULL)
1253: {
1254: free((*s_etat_processus).instruction_courante);
1255: return(d_erreur);
1256: }
1257:
1258: /*
1259: * Traitement de la pile système par les
1260: * différentes instructions.
1261: */
1262:
1263: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1264: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1265: (strcmp(instruction_majuscule, "DO") == 0) ||
1266: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1267: (strcmp(instruction_majuscule, "FOR") == 0) ||
1268: (strcmp(instruction_majuscule, "FORALL") == 0)
1269: ||
1270: (strcmp(instruction_majuscule, "START") == 0) ||
1271: (strcmp(instruction_majuscule, "SELECT") == 0)
1272: ||
1273: (strcmp(instruction_majuscule, "CRITICAL") == 0)
1274: || (strcmp(instruction_majuscule, "CASE") == 0)
1275: || (strcmp(instruction_majuscule, "<<") == 0))
1276: {
1277: if (strcmp(instruction_majuscule, "<<") == 0)
1278: {
1279: analyse(s_etat_processus, NULL);
1280: }
1281: else if ((strcmp(instruction_majuscule, "FOR") == 0)
1282: || (strcmp(instruction_majuscule, "FORALL")
1283: == 0) || (strcmp(instruction_majuscule,
1284: "START") == 0))
1285: {
1286: empilement_pile_systeme(s_etat_processus);
1287:
1288: if ((*s_etat_processus).erreur_systeme != d_es)
1289: {
1290: return(d_erreur);
1291: }
1292:
1293: (*(*s_etat_processus).l_base_pile_systeme)
1294: .type_cloture = 'L';
1295: }
1296: else
1297: {
1298: empilement_pile_systeme(s_etat_processus);
1299:
1300: if ((*s_etat_processus).erreur_systeme != d_es)
1301: {
1302: return(d_erreur);
1303: }
1304: }
1305: }
1306: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1307: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1308: (strcmp(instruction_majuscule, "STEP") == 0) ||
1309: (strcmp(instruction_majuscule, ">>") == 0))
1310: {
1311: if (strcmp(instruction_majuscule, ">>") == 0)
1312: {
1313: analyse(s_etat_processus, NULL);
1314:
1315: if ((*(*s_etat_processus).l_base_pile_systeme)
1316: .origine_routine_evaluation == 'Y')
1317: {
1318: free(instruction_majuscule);
1319: free((*s_etat_processus)
1320: .instruction_courante);
1321:
1322: (*s_etat_processus).instruction_courante =
1323: tampon;
1324:
1325: return(d_absence_erreur);
1326: }
1327: }
1328: else if (((strcmp(instruction_majuscule, "NEXT")
1329: == 0) || (strcmp(instruction_majuscule,
1330: "STEP") == 0)) && ((*(*s_etat_processus)
1331: .l_base_pile_systeme).type_cloture != 'L'))
1332: {
1333: /*
1334: * Libération des compteurs de boucle.
1335: */
1336:
1337: presence_compteur = (((*(*s_etat_processus)
1338: .l_base_pile_systeme).type_cloture
1339: == 'F') || ((*(*s_etat_processus)
1340: .l_base_pile_systeme).type_cloture
1341: == 'A')) ? d_vrai : d_faux;
1342:
1343: if (((*(*s_etat_processus).l_base_pile_systeme)
1344: .type_cloture != 'S') &&
1345: (presence_compteur == d_faux))
1346: {
1347: return(d_erreur);
1348: }
1349:
1350: if (presence_compteur == d_vrai)
1351: {
1352: if (recherche_variable(s_etat_processus,
1353: (*(*s_etat_processus)
1354: .l_base_pile_systeme).nom_variable)
1355: == d_faux)
1356: {
1357: return(d_erreur);
1358: }
1359:
1360: if ((*(*s_etat_processus)
1361: .pointeur_variable_courante).objet
1362: == NULL)
1363: {
1364: return(d_erreur);
1365: }
1366:
1367: (*s_etat_processus).niveau_courant--;
1368:
1369: if (retrait_variables_par_niveau(
1370: s_etat_processus) == d_erreur)
1371: {
1372: return(d_erreur);
1373: }
1374: }
1375:
1376: depilement_pile_systeme(s_etat_processus);
1377:
1378: if ((*s_etat_processus).erreur_systeme != d_es)
1379: {
1380: return(d_erreur);
1381: }
1382: }
1383: else
1384: {
1385: // Traitement spécifique pour la fin
1386: // d'une section critique
1387:
1388: if ((*s_etat_processus).l_base_pile_systeme
1389: == NULL)
1390: {
1391: (*s_etat_processus).erreur_systeme =
1392: d_es_processus;
1393: return(d_erreur);
1394: }
1395:
1396: if ((*(*s_etat_processus).l_base_pile_systeme)
1397: .type_cloture == 'Q')
1398: {
1399: if (pthread_mutex_unlock(
1400: &mutex_sections_critiques) != 0)
1401: {
1402: (*s_etat_processus).erreur_systeme =
1403: d_es_processus;
1404: return(d_erreur);
1405: }
1406:
1407: (*s_etat_processus).sections_critiques--;
1408: }
1409:
1410: depilement_pile_systeme(s_etat_processus);
1411:
1412: if ((*s_etat_processus).erreur_systeme != d_es)
1413: {
1414: return(d_erreur);
1415: }
1416: }
1417: }
1418:
1419: free(instruction_majuscule);
1420: }
1421:
1422: free((*s_etat_processus).instruction_courante);
1423: }
1424:
1425: drapeau_then = d_faux;
1426: niveau = 0;
1427:
1428: do
1429: {
1430: erreur = recherche_instruction_suivante(s_etat_processus);
1431:
1432: if (erreur == d_erreur)
1433: {
1434: return(d_erreur);
1435: }
1436:
1437: instruction_majuscule = conversion_majuscule(
1438: s_etat_processus,
1439: (*s_etat_processus).instruction_courante);
1440:
1441: if (instruction_majuscule == NULL)
1442: {
1443: return(d_erreur);
1444: }
1445:
1446: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1447: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1448: (strcmp(instruction_majuscule, "DO") == 0) ||
1449: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1450: (strcmp(instruction_majuscule, "FOR") == 0) ||
1451: (strcmp(instruction_majuscule, "FORALL") == 0) ||
1452: (strcmp(instruction_majuscule, "START") == 0) ||
1453: (strcmp(instruction_majuscule, "SELECT") == 0)
1454: || (strcmp(instruction_majuscule, "CRITICAL") == 0)
1455: || (strcmp(instruction_majuscule, "CASE") == 0)
1456: || (strcmp(instruction_majuscule, "<<") == 0))
1457: {
1458: niveau++;
1459: }
1460: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1461: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1462: (strcmp(instruction_majuscule, "STEP") == 0) ||
1463: (strcmp(instruction_majuscule, ">>") == 0))
1464: {
1465: niveau--;
1466: }
1467:
1468: drapeau_then = ((strcmp(instruction_majuscule, "THEN") == 0)
1469: && (niveau == 0)) ? d_vrai : d_faux;
1470:
1471: free(instruction_majuscule);
1472: free((*s_etat_processus).instruction_courante);
1473: } while(drapeau_then == d_faux);
1474:
1475: (*s_etat_processus).position_courante -= 5;
1476: (*s_etat_processus).instruction_courante = tampon;
1477: (*(*s_etat_processus).l_base_pile_systeme).clause = 'X';
1478:
1479: erreur = d_absence_erreur;
1480: (*s_etat_processus).exception = d_ep;
1481: (*s_etat_processus).erreur_execution = d_ex;
1482: }
1483: }
1484: else
1485: {
1486: drapeau_fin = d_faux;
1487: }
1488:
1489: if (erreur == d_absence_erreur)
1490: {
1491: free((*s_etat_processus).instruction_courante);
1492: }
1493: } while((erreur == d_absence_erreur) &&
1494: ((*s_etat_processus).position_courante <
1495: (*s_etat_processus).longueur_definitions_chainees) &&
1496: (drapeau_fin == d_faux) &&
1497: ((*s_etat_processus).retour_routine_evaluation == 'N'));
1498:
1499: /*
1500: --------------------------------------------------------------------------------
1501: Messages d'erreur à afficher le cas échéant
1502: --------------------------------------------------------------------------------
1503: */
1504:
1505: if ((erreur != d_absence_erreur) && ((*s_etat_processus)
1506: .invalidation_message_erreur == d_faux))
1507: {
1508: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1509: {
1510: l_element_courant = (*s_etat_processus).l_base_pile_last;
1511:
1512: while(l_element_courant != NULL)
1513: {
1514: if ((s_objet = copie_objet(s_etat_processus,
1515: (*l_element_courant).donnee, 'P')) == NULL)
1516: {
1517: (*s_etat_processus).erreur_systeme =
1518: d_es_allocation_memoire;
1519: return(d_erreur);
1520: }
1521:
1522: if (empilement(s_etat_processus, &((*s_etat_processus)
1523: .l_base_pile), s_objet) == d_erreur)
1524: {
1525: return(d_erreur);
1526: }
1527:
1528: l_element_courant = (*l_element_courant).suivant;
1529: }
1530: }
1531:
1532: if (test_cfsf(s_etat_processus, 51) == d_faux)
1533: {
1534: printf("%s", ds_beep);
1535: }
1536:
1537: if ((message = messages(s_etat_processus)) == NULL)
1538: {
1539: return(d_erreur);
1540: }
1541:
1542: printf("%s [%d]\n", message, (int) getpid());
1543:
1544: free(message);
1545: free((*s_etat_processus).instruction_courante);
1546:
1547: if ((*s_etat_processus).var_volatile_processus_pere == 0)
1548: {
1549: envoi_signal_processus((*s_etat_processus).pid_processus_pere,
1550: rpl_sigalrm, d_faux);
1551: }
1552: else
1553: {
1554: (*s_etat_processus).var_volatile_alarme = -1;
1555: }
1556:
1557: return(d_erreur);
1558: }
1559:
1560: return(d_absence_erreur);
1561: }
1562:
1563: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sequenceur.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / src