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