1: /*
2: ================================================================================
3: RPL/2 (R) version 4.1.21
4: Copyright (C) 1989-2015 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: analyse(s_etat_processus, NULL);
545:
546: if ((*s_etat_processus).traitement_cycle_exit != 'N')
547: {
548: switch((*s_etat_processus).traitement_cycle_exit)
549: {
550: case 'C' :
551: {
552: instruction_cycle(s_etat_processus);
553: break;
554: }
555:
556: case 'E' :
557: {
558: instruction_exit(s_etat_processus);
559: break;
560: }
561: }
562: }
563:
564: if ((*s_etat_processus).instruction_valide == 'N')
565: {
566:
567: /*
568: --------------------------------------------------------------------------------
569: L'instruction ne correspond pas à l'un des mots clef du langage RPL/2.
570: --------------------------------------------------------------------------------
571: */
572:
573: if ((recherche_variable(s_etat_processus,
574: (*s_etat_processus).instruction_courante) ==
575: d_vrai) && ((*s_etat_processus)
576: .autorisation_evaluation_nom == 'Y'))
577: {
578: if ((*(*s_etat_processus).pointeur_variable_courante)
579: .objet == NULL)
580: {
581:
582: /*
583: --------------------------------------------------------------------------------
584: L'instruction est une variable partagée
585: --------------------------------------------------------------------------------
586: */
587:
588: if ((*s_etat_processus).debug == d_vrai)
589: if (((*s_etat_processus).type_debug &
590: d_debug_variables) != 0)
591: {
592: if ((*s_etat_processus).langue == 'F')
593: {
594: printf("[%d] Évaluation de la variable "
595: "partagée %s de type %d\n",
596: (int) getpid(), (*s_etat_processus)
597: .instruction_courante,
598: (*(*(*s_etat_processus)
599: .pointeur_variable_courante).objet)
600: .type);
601: }
602: else
603: {
604: printf("[%d] Pushing %s as %d type shared "
605: "variable\n", (int) getpid(),
606: (*s_etat_processus)
607: .instruction_courante,
608: (*(*(*s_etat_processus)
609: .pointeur_variable_courante).objet)
610: .type);
611: }
612:
613: fflush(stdout);
614: }
615:
616: if (recherche_variable_partagee(s_etat_processus,
617: (*(*s_etat_processus)
618: .pointeur_variable_courante).nom,
619: (*(*s_etat_processus)
620: .pointeur_variable_courante).variable_partagee,
621: 'P') != NULL)
622: {
623: // La variable existe.
624:
625: if ((s_objet = copie_objet(s_etat_processus,
626: (*(*s_etat_processus)
627: .pointeur_variable_partagee_courante)
628: .objet, 'P')) == NULL)
629: {
630: (*s_etat_processus).erreur_systeme =
631: d_es_allocation_memoire;
632: return(d_erreur);
633: }
634:
635: if (pthread_mutex_unlock(&((*(*s_etat_processus)
636: .pointeur_variable_partagee_courante)
637: .mutex)) != 0)
638: {
639: (*s_etat_processus).erreur_systeme =
640: d_es_processus;
641: return(d_erreur);
642: }
643:
644: if (evaluation(s_etat_processus, s_objet, 'E')
645: == d_erreur)
646: {
647: liberation(s_etat_processus, s_objet);
648: return(d_erreur);
649: }
650:
651: liberation(s_etat_processus, s_objet);
652: }
653: else
654: {
655: // La variable n'existe plus.
656: }
657: }
658:
659: /*
660: --------------------------------------------------------------------------------
661: L'instruction est une variable automatique (évaluation lors de l'empilement).
662: --------------------------------------------------------------------------------
663: */
664:
665: else if ((*(*(*s_etat_processus).pointeur_variable_courante)
666: .objet).type == ADR)
667: {
668:
669: /*
670: --------------------------------------------------------------------------------
671: L'instruction est une variable de type 'adresse' pointant sur une
672: définition. Un branchement est effectué à cette adresse.
673: --------------------------------------------------------------------------------
674: */
675:
676: if ((*s_etat_processus).debug == d_vrai)
677: if (((*s_etat_processus).type_debug &
678: d_debug_appels_fonctions) != 0)
679: {
680: if ((*s_etat_processus).langue == 'F')
681: {
682: printf("[%d] Branchement à la"
683: " définition %s\n", (int) getpid(),
684: (*s_etat_processus)
685: .instruction_courante);
686: }
687: else
688: {
689: printf("[%d] Execution : "
690: "Branching at %s definition\n",
691: (int) getpid(), (*s_etat_processus)
692: .instruction_courante);
693: }
694:
695: fflush(stdout);
696: }
697:
698: (*s_etat_processus).autorisation_empilement_programme =
699: 'N';
700:
701: empilement_pile_systeme(s_etat_processus);
702:
703: if ((*s_etat_processus).erreur_systeme != d_es)
704: {
705: erreur = d_erreur;
706: }
707: else
708: {
709: if ((*s_etat_processus).profilage == d_vrai)
710: {
711: profilage(s_etat_processus,
712: (*s_etat_processus)
713: .instruction_courante);
714:
715: if ((*s_etat_processus).erreur_systeme != d_es)
716: {
717: return(d_erreur);
718: }
719: }
720:
721: (*(*s_etat_processus).l_base_pile_systeme)
722: .adresse_retour = (*s_etat_processus)
723: .position_courante;
724:
725: (*(*s_etat_processus).l_base_pile_systeme)
726: .retour_definition = 'Y';
727:
728: (*(*s_etat_processus).l_base_pile_systeme)
729: .niveau_courant = (*s_etat_processus)
730: .niveau_courant;
731:
732: (*s_etat_processus).position_courante =
733: (*((integer8 *)
734: ((*(*(*s_etat_processus)
735: .pointeur_variable_courante)
736: .objet).objet)));
737:
738: drapeau_appel_definition = d_vrai;
739: }
740: }
741: else
742: {
743: if ((*s_etat_processus).debug == d_vrai)
744: if (((*s_etat_processus).type_debug &
745: d_debug_variables) != 0)
746: {
747: if ((*s_etat_processus).langue == 'F')
748: {
749: printf("[%d] Évaluation de la variable "
750: "%s de type %d\n",
751: (int) getpid(),
752: (*s_etat_processus)
753: .instruction_courante,
754: (*(*(*s_etat_processus)
755: .pointeur_variable_courante).objet)
756: .type);
757: }
758: else
759: {
760: printf("[%d] Pushing %s as %d type variable "
761: "\n", (int) getpid(),
762: (*s_etat_processus)
763: .instruction_courante,
764: (*(*(*s_etat_processus)
765: .pointeur_variable_courante).objet)
766: .type);
767: }
768:
769: fflush(stdout);
770: }
771:
772: if ((s_objet = copie_objet(s_etat_processus,
773: (*(*s_etat_processus)
774: .pointeur_variable_courante).objet, 'P'))
775: == NULL)
776: {
777: (*s_etat_processus).erreur_systeme =
778: d_es_allocation_memoire;
779: return(d_erreur);
780: }
781:
782: if (evaluation(s_etat_processus, s_objet, 'E')
783: == d_erreur)
784: {
785: liberation(s_etat_processus, s_objet);
786: return(d_erreur);
787: }
788:
789: liberation(s_etat_processus, s_objet);
790: }
791: }
792: else
793: {
794:
795: /*
796: --------------------------------------------------------------------------------
797: L'instruction est une donnée à empiler.
798: --------------------------------------------------------------------------------
799: */
800:
801: (*s_etat_processus).erreur_systeme = d_es;
802: (*s_etat_processus).type_en_cours = NON;
803: recherche_type(s_etat_processus);
804:
805: if ((*s_etat_processus).autorisation_nom_implicite == 'N')
806: {
807: if ((*s_etat_processus).l_base_pile == NULL)
808: {
809: if (((*s_etat_processus).erreur_execution !=
810: d_ex_nom_implicite) &&
811: ((*s_etat_processus).erreur_execution !=
812: d_ex_syntaxe))
813: {
814: (*s_etat_processus).erreur_execution =
815: d_ex_manque_argument;
816: }
817: }
818: else if ((*(*(*s_etat_processus).l_base_pile).donnee)
819: .type == NOM)
820: {
821: if ((*((struct_nom *) (*(*(*s_etat_processus)
822: .l_base_pile).donnee).objet)).symbole
823: == d_faux)
824: {
825: (*s_etat_processus).erreur_execution =
826: d_ex_nom_implicite;
827:
828: // Si le niveau de récursivité est non nul, on
829: // arrive ici depuis la fonction
830: // recherche_type(). On retourne à cette
831: // dernière en indiquant une erreur.
832:
833: if ((*s_etat_processus).niveau_recursivite != 0)
834: {
835: free((*s_etat_processus)
836: .instruction_courante);
837: return(d_erreur);
838: }
839: }
840: }
841: }
842:
843: // Le séquenceur est appelé depuis la routine d'évaluation
844:
845: if ((*s_etat_processus).evaluation_forcee == 'Y')
846: {
847: if (depilement(s_etat_processus,
848: &((*s_etat_processus).l_base_pile),
849: &s_objet_evaluation) == d_erreur)
850: {
851: free((*s_etat_processus).instruction_courante);
852: (*s_etat_processus).erreur_execution =
853: d_ex_manque_argument;
854: return(d_erreur);
855: }
856:
857: if (evaluation(s_etat_processus, s_objet_evaluation,
858: 'N') == d_erreur)
859: {
860: free((*s_etat_processus).instruction_courante);
861: liberation(s_etat_processus, s_objet_evaluation);
862: return(d_erreur);
863: }
864:
865: liberation(s_etat_processus, s_objet_evaluation);
866: }
867:
868: // Le séquenceur est appelé depuis la routine de
869: // recherche de type
870:
871: else if ((*s_etat_processus).recherche_type == 'Y')
872: {
873: if ((*s_etat_processus).erreur_execution != d_ex)
874: {
875: free((*s_etat_processus).instruction_courante);
876: return(d_erreur);
877: }
878: }
879: }
880: }
881: else if (((*s_etat_processus).test_instruction == 'Y') &&
882: ((*s_etat_processus).instruction_valide == 'Y'))
883: {
884:
885: /*
886: --------------------------------------------------------------------------------
887: Permet de traiter les fonctions dans les objets de type liste
888: --------------------------------------------------------------------------------
889: */
890:
891: if ((instruction_majuscule = conversion_majuscule(
892: s_etat_processus, (*s_etat_processus)
893: .instruction_courante)) == NULL)
894: {
895: (*s_etat_processus).erreur_systeme =
896: d_es_allocation_memoire;
897: return(d_erreur);
898: }
899:
900: if ((strcmp((*s_etat_processus).instruction_courante, "<<")
901: != 0) && (strcmp((*s_etat_processus)
902: .instruction_courante, ">>") != 0))
903: {
904: if ((s_objet = allocation(s_etat_processus, FCT)) == NULL)
905: {
906: (*s_etat_processus).erreur_systeme =
907: d_es_allocation_memoire;
908: return(d_erreur);
909: }
910:
911: (*((struct_fonction *) (*s_objet).objet))
912: .nombre_arguments = 0;
913:
914: if ((*s_etat_processus).instruction_intrinseque == 'Y')
915: {
916: if (((*((struct_fonction *) (*s_objet).objet))
917: .nom_fonction = 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: else
927: {
928: if (((*((struct_fonction *) (*s_objet).objet))
929: .nom_fonction = (unsigned char *) malloc(
930: (strlen((*s_etat_processus)
931: .instruction_courante)
932: + 1) * sizeof(unsigned char))) == NULL)
933: {
934: (*s_etat_processus).erreur_systeme =
935: d_es_allocation_memoire;
936: return(d_erreur);
937: }
938:
939: strcpy((*((struct_fonction *) (*s_objet).objet))
940: .nom_fonction, (*s_etat_processus)
941: .instruction_courante);
942: }
943:
944: (*((struct_fonction *) (*s_objet).objet)).fonction =
945: analyse_instruction(s_etat_processus,
946: (*s_etat_processus).instruction_courante);
947:
948: if (empilement(s_etat_processus,
949: &((*s_etat_processus).l_base_pile), s_objet) ==
950: d_erreur)
951: {
952: (*s_etat_processus).erreur_systeme =
953: d_es_allocation_memoire;
954: return(d_erreur);
955: }
956: }
957: else
958: {
959: (*s_etat_processus).test_instruction = 'N';
960: analyse(s_etat_processus, NULL);
961: (*s_etat_processus).test_instruction = 'Y';
962: }
963:
964: free(instruction_majuscule);
965: }
966:
967: erreur = (logical1) (erreur | (((*s_etat_processus)
968: .erreur_execution != d_ex) ? d_erreur : d_absence_erreur));
969: }
970: else
971: {
972: printf("\n");
973:
974: if ((*s_etat_processus).langue == 'F')
975: {
976: printf("+++Erreur : Argument %s invalide\n",
977: (*s_etat_processus).instruction_courante);
978: }
979: else
980: {
981: printf("+++Error : Invalid %s argument\n",
982: (*s_etat_processus).instruction_courante);
983: }
984:
985: fflush(stdout);
986:
987: free((*s_etat_processus).instruction_courante);
988: return(d_erreur);
989: }
990:
991: /*
992: --------------------------------------------------------------------------------
993: Traitement des arrêts simples
994: --------------------------------------------------------------------------------
995: */
996:
997: if ((*s_etat_processus).var_volatile_requete_arret2 != 0)
998: {
999: if ((*s_etat_processus).debug_programme == d_vrai)
1000: {
1001: (*s_etat_processus).var_volatile_requete_arret2 = 0;
1002: }
1003: else
1004: {
1005: if ((*s_etat_processus).var_volatile_requete_arret2 == -1)
1006: {
1007: if (strncmp(getenv("LANG"), "fr", 2) == 0)
1008: {
1009: printf("[%d] Arrêt\n", (int) getpid());
1010: }
1011: else
1012: {
1013: printf("[%d] Break\n", (int) getpid());
1014: }
1015:
1016: (*s_etat_processus).var_volatile_requete_arret2 = 1;
1017:
1018: fflush(stdout);
1019: }
1020:
1021: if ((*s_etat_processus).niveau_recursivite == 0)
1022: {
1023: (*s_etat_processus).debug_programme = d_vrai;
1024: (*s_etat_processus).var_volatile_requete_arret2 = 0;
1025: }
1026: }
1027: }
1028:
1029: /*
1030: * On ne sort pas du debugger en cas d'une erreur sur un programme
1031: * en cours de débogage.
1032: */
1033:
1034: if ((((*s_etat_processus).erreur_execution != d_ex) ||
1035: ((*s_etat_processus).exception != d_ep)) &&
1036: ((*s_etat_processus).debug_programme == d_vrai))
1037: {
1038: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1039: {
1040: l_element_courant = (*s_etat_processus).l_base_pile_last;
1041:
1042: while(l_element_courant != NULL)
1043: {
1044: if ((s_objet = copie_objet(s_etat_processus,
1045: (*l_element_courant).donnee, 'P')) == NULL)
1046: {
1047: (*s_etat_processus).erreur_systeme =
1048: d_es_allocation_memoire;
1049: return(d_erreur);
1050: }
1051:
1052: if (empilement(s_etat_processus, &((*s_etat_processus)
1053: .l_base_pile), s_objet) == d_erreur)
1054: {
1055: return(d_erreur);
1056: }
1057:
1058: l_element_courant = (*l_element_courant).suivant;
1059: }
1060: }
1061:
1062: if (test_cfsf(s_etat_processus, 51) == d_faux)
1063: {
1064: printf("%s", ds_beep);
1065: }
1066:
1067: if ((message = messages(s_etat_processus)) == NULL)
1068: {
1069: free((*s_etat_processus).instruction_courante);
1070: return(d_erreur);
1071: }
1072:
1073: printf("%s [%d]\n", message, (int) getpid());
1074:
1075: free(message);
1076:
1077: (*s_etat_processus).erreur_execution = d_ex;
1078: (*s_etat_processus).exception = d_ep;
1079: erreur = d_absence_erreur;
1080:
1081: (*s_etat_processus).position_courante -= (integer8)
1082: strlen((*s_etat_processus).instruction_courante);
1083: }
1084:
1085: /*
1086: --------------------------------------------------------------------------------
1087: Test de fin d'exécution du programme RPL/2
1088: --------------------------------------------------------------------------------
1089: */
1090:
1091: if (((*s_etat_processus).niveau_courant == 0) &&
1092: (drapeau_appel_definition != d_vrai))
1093: {
1094: drapeau_fin = d_vrai;
1095: }
1096: else if ((*s_etat_processus).requete_arret == 'Y')
1097: {
1098: drapeau_fin = d_vrai;
1099: }
1100: else if (((*s_etat_processus).var_volatile_requete_arret != 0)
1101: && ((*s_etat_processus).debug_programme == d_faux))
1102: {
1103: drapeau_fin = d_vrai;
1104:
1105: if ((*s_etat_processus).erreur_systeme == d_es)
1106: {
1107: erreur = d_absence_erreur;
1108: }
1109: }
1110: else if ((*s_etat_processus).arret_si_exception == d_vrai)
1111: {
1112: drapeau_fin = d_faux;
1113:
1114: if ((*s_etat_processus).exception != d_ep)
1115: {
1116: erreur = d_erreur;
1117: }
1118: else if ((*s_etat_processus).erreur_systeme != d_es)
1119: {
1120: erreur = d_erreur;
1121: }
1122: }
1123: else if ((*s_etat_processus).arret_si_exception == d_faux)
1124: {
1125: if ((message = messages(s_etat_processus)) == NULL)
1126: {
1127: (*s_etat_processus).erreur_systeme = d_es_allocation_memoire;
1128: return(d_erreur);
1129: }
1130:
1131: free(message);
1132:
1133: drapeau_fin = d_faux;
1134:
1135: /*
1136: --------------------------------------------------------------------------------
1137: Traitement des exceptions
1138: --------------------------------------------------------------------------------
1139: */
1140:
1141: if ((*s_etat_processus).erreur_systeme != d_es)
1142: {
1143: erreur = d_erreur;
1144: }
1145: else if (((*s_etat_processus).exception != d_ep) ||
1146: ((*s_etat_processus).erreur_execution != d_ex))
1147: {
1148: tampon = (*s_etat_processus).instruction_courante;
1149:
1150: while((*(*s_etat_processus).l_base_pile_systeme).clause != 'R')
1151: {
1152: erreur = recherche_instruction_suivante(s_etat_processus);
1153:
1154: if (erreur == d_erreur)
1155: {
1156: free((*s_etat_processus).instruction_courante);
1157: return(d_erreur);
1158: }
1159:
1160: if (recherche_variable(s_etat_processus,
1161: (*s_etat_processus).instruction_courante) == d_vrai)
1162: {
1163: if ((*(*s_etat_processus).pointeur_variable_courante)
1164: .objet == NULL)
1165: {
1166: // Variable partagée
1167: }
1168: else if ((*(*(*s_etat_processus)
1169: .pointeur_variable_courante).objet).type == ADR)
1170: {
1171: empilement_pile_systeme(s_etat_processus);
1172:
1173: if ((*s_etat_processus).erreur_systeme != d_es)
1174: {
1175: free((*s_etat_processus).instruction_courante);
1176: return(d_erreur);
1177: }
1178:
1179: (*(*s_etat_processus).l_base_pile_systeme)
1180: .adresse_retour = (*s_etat_processus)
1181: .position_courante;
1182:
1183: (*(*s_etat_processus).l_base_pile_systeme)
1184: .retour_definition = 'Y';
1185:
1186: (*(*s_etat_processus).l_base_pile_systeme)
1187: .niveau_courant = (*s_etat_processus)
1188: .niveau_courant;
1189:
1190: (*s_etat_processus).position_courante =
1191: (*((integer8 *)
1192: ((*(*(*s_etat_processus)
1193: .pointeur_variable_courante)
1194: .objet).objet)));
1195:
1196: (*s_etat_processus)
1197: .autorisation_empilement_programme = 'N';
1198: }
1199: }
1200: else
1201: {
1202: (*s_etat_processus).erreur_systeme = d_es;
1203: instruction_majuscule = conversion_majuscule(
1204: s_etat_processus, (*s_etat_processus)
1205: .instruction_courante);
1206:
1207: if (instruction_majuscule == NULL)
1208: {
1209: free((*s_etat_processus).instruction_courante);
1210: return(d_erreur);
1211: }
1212:
1213: /*
1214: * Traitement de la pile système par les
1215: * différentes instructions.
1216: */
1217:
1218: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1219: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1220: (strcmp(instruction_majuscule, "DO") == 0) ||
1221: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1222: (strcmp(instruction_majuscule, "FOR") == 0) ||
1223: (strcmp(instruction_majuscule, "FORALL") == 0)
1224: ||
1225: (strcmp(instruction_majuscule, "START") == 0) ||
1226: (strcmp(instruction_majuscule, "SELECT") == 0)
1227: ||
1228: (strcmp(instruction_majuscule, "CRITICAL") == 0)
1229: || (strcmp(instruction_majuscule, "CASE") == 0)
1230: || (strcmp(instruction_majuscule, "<<") == 0))
1231: {
1232: if (strcmp(instruction_majuscule, "<<") == 0)
1233: {
1234: analyse(s_etat_processus, NULL);
1235: }
1236: else if ((strcmp(instruction_majuscule, "FOR") == 0)
1237: || (strcmp(instruction_majuscule, "FORALL")
1238: == 0) || (strcmp(instruction_majuscule,
1239: "START") == 0))
1240: {
1241: empilement_pile_systeme(s_etat_processus);
1242:
1243: if ((*s_etat_processus).erreur_systeme != d_es)
1244: {
1245: return(d_erreur);
1246: }
1247:
1248: (*(*s_etat_processus).l_base_pile_systeme)
1249: .type_cloture = 'L';
1250: }
1251: else
1252: {
1253: empilement_pile_systeme(s_etat_processus);
1254:
1255: if ((*s_etat_processus).erreur_systeme != d_es)
1256: {
1257: return(d_erreur);
1258: }
1259: }
1260: }
1261: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1262: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1263: (strcmp(instruction_majuscule, "STEP") == 0) ||
1264: (strcmp(instruction_majuscule, ">>") == 0))
1265: {
1266: if (strcmp(instruction_majuscule, ">>") == 0)
1267: {
1268: analyse(s_etat_processus, NULL);
1269:
1270: if ((*(*s_etat_processus).l_base_pile_systeme)
1271: .origine_routine_evaluation == 'Y')
1272: {
1273: free(instruction_majuscule);
1274: free((*s_etat_processus)
1275: .instruction_courante);
1276:
1277: (*s_etat_processus).instruction_courante =
1278: tampon;
1279:
1280: return(d_absence_erreur);
1281: }
1282: }
1283: else if (((strcmp(instruction_majuscule, "NEXT")
1284: == 0) || (strcmp(instruction_majuscule,
1285: "STEP") == 0)) && ((*(*s_etat_processus)
1286: .l_base_pile_systeme).type_cloture != 'L'))
1287: {
1288: /*
1289: * Libération des compteurs de boucle.
1290: */
1291:
1292: presence_compteur = (((*(*s_etat_processus)
1293: .l_base_pile_systeme).type_cloture
1294: == 'F') || ((*(*s_etat_processus)
1295: .l_base_pile_systeme).type_cloture
1296: == 'A')) ? d_vrai : d_faux;
1297:
1298: if (((*(*s_etat_processus).l_base_pile_systeme)
1299: .type_cloture != 'S') &&
1300: (presence_compteur == d_faux))
1301: {
1302: return(d_erreur);
1303: }
1304:
1305: if (presence_compteur == d_vrai)
1306: {
1307: if (recherche_variable(s_etat_processus,
1308: (*(*s_etat_processus)
1309: .l_base_pile_systeme).nom_variable)
1310: == d_faux)
1311: {
1312: return(d_erreur);
1313: }
1314:
1315: if ((*(*s_etat_processus)
1316: .pointeur_variable_courante).objet
1317: == NULL)
1318: {
1319: return(d_erreur);
1320: }
1321:
1322: (*s_etat_processus).niveau_courant--;
1323:
1324: if (retrait_variables_par_niveau(
1325: s_etat_processus) == d_erreur)
1326: {
1327: return(d_erreur);
1328: }
1329: }
1330:
1331: depilement_pile_systeme(s_etat_processus);
1332:
1333: if ((*s_etat_processus).erreur_systeme != d_es)
1334: {
1335: return(d_erreur);
1336: }
1337: }
1338: else
1339: {
1340: // Traitement spécifique pour la fin
1341: // d'une section critique
1342:
1343: if ((*s_etat_processus).l_base_pile_systeme
1344: == NULL)
1345: {
1346: (*s_etat_processus).erreur_systeme =
1347: d_es_processus;
1348: return(d_erreur);
1349: }
1350:
1351: if ((*(*s_etat_processus).l_base_pile_systeme)
1352: .type_cloture == 'Q')
1353: {
1354: if (pthread_mutex_unlock(
1355: &mutex_sections_critiques) != 0)
1356: {
1357: (*s_etat_processus).erreur_systeme =
1358: d_es_processus;
1359: return(d_erreur);
1360: }
1361:
1362: (*s_etat_processus).sections_critiques--;
1363: }
1364:
1365: depilement_pile_systeme(s_etat_processus);
1366:
1367: if ((*s_etat_processus).erreur_systeme != d_es)
1368: {
1369: return(d_erreur);
1370: }
1371: }
1372: }
1373:
1374: free(instruction_majuscule);
1375: }
1376:
1377: free((*s_etat_processus).instruction_courante);
1378: }
1379:
1380: drapeau_then = d_faux;
1381: niveau = 0;
1382:
1383: do
1384: {
1385: erreur = recherche_instruction_suivante(s_etat_processus);
1386:
1387: if (erreur == d_erreur)
1388: {
1389: return(d_erreur);
1390: }
1391:
1392: instruction_majuscule = conversion_majuscule(
1393: s_etat_processus,
1394: (*s_etat_processus).instruction_courante);
1395:
1396: if (instruction_majuscule == NULL)
1397: {
1398: return(d_erreur);
1399: }
1400:
1401: if ((strcmp(instruction_majuscule, "IF") == 0) ||
1402: (strcmp(instruction_majuscule, "IFERR") == 0) ||
1403: (strcmp(instruction_majuscule, "DO") == 0) ||
1404: (strcmp(instruction_majuscule, "WHILE") == 0) ||
1405: (strcmp(instruction_majuscule, "FOR") == 0) ||
1406: (strcmp(instruction_majuscule, "FORALL") == 0) ||
1407: (strcmp(instruction_majuscule, "START") == 0) ||
1408: (strcmp(instruction_majuscule, "SELECT") == 0)
1409: || (strcmp(instruction_majuscule, "CRITICAL") == 0)
1410: || (strcmp(instruction_majuscule, "CASE") == 0)
1411: || (strcmp(instruction_majuscule, "<<") == 0))
1412: {
1413: niveau++;
1414: }
1415: else if ((strcmp(instruction_majuscule, "END") == 0) ||
1416: (strcmp(instruction_majuscule, "NEXT") == 0) ||
1417: (strcmp(instruction_majuscule, "STEP") == 0) ||
1418: (strcmp(instruction_majuscule, ">>") == 0))
1419: {
1420: niveau--;
1421: }
1422:
1423: drapeau_then = ((strcmp(instruction_majuscule, "THEN") == 0)
1424: && (niveau == 0)) ? d_vrai : d_faux;
1425:
1426: free(instruction_majuscule);
1427: free((*s_etat_processus).instruction_courante);
1428: } while(drapeau_then == d_faux);
1429:
1430: (*s_etat_processus).position_courante -= 5;
1431: (*s_etat_processus).instruction_courante = tampon;
1432: (*(*s_etat_processus).l_base_pile_systeme).clause = 'X';
1433:
1434: erreur = d_absence_erreur;
1435: (*s_etat_processus).exception = d_ep;
1436: (*s_etat_processus).erreur_execution = d_ex;
1437: }
1438: }
1439: else
1440: {
1441: drapeau_fin = d_faux;
1442: }
1443:
1444: if (erreur == d_absence_erreur)
1445: {
1446: free((*s_etat_processus).instruction_courante);
1447: }
1448: } while((erreur == d_absence_erreur) &&
1449: ((*s_etat_processus).position_courante <
1450: (*s_etat_processus).longueur_definitions_chainees) &&
1451: (drapeau_fin == d_faux) &&
1452: ((*s_etat_processus).retour_routine_evaluation == 'N'));
1453:
1454: /*
1455: --------------------------------------------------------------------------------
1456: Messages d'erreur à afficher le cas échéant
1457: --------------------------------------------------------------------------------
1458: */
1459:
1460: if ((erreur != d_absence_erreur) && ((*s_etat_processus)
1461: .invalidation_message_erreur == d_faux))
1462: {
1463: if (test_cfsf(s_etat_processus, 31) == d_vrai)
1464: {
1465: l_element_courant = (*s_etat_processus).l_base_pile_last;
1466:
1467: while(l_element_courant != NULL)
1468: {
1469: if ((s_objet = copie_objet(s_etat_processus,
1470: (*l_element_courant).donnee, 'P')) == NULL)
1471: {
1472: (*s_etat_processus).erreur_systeme =
1473: d_es_allocation_memoire;
1474: return(d_erreur);
1475: }
1476:
1477: if (empilement(s_etat_processus, &((*s_etat_processus)
1478: .l_base_pile), s_objet) == d_erreur)
1479: {
1480: return(d_erreur);
1481: }
1482:
1483: l_element_courant = (*l_element_courant).suivant;
1484: }
1485: }
1486:
1487: if (test_cfsf(s_etat_processus, 51) == d_faux)
1488: {
1489: printf("%s", ds_beep);
1490: }
1491:
1492: if ((message = messages(s_etat_processus)) == NULL)
1493: {
1494: return(d_erreur);
1495: }
1496:
1497: printf("%s [%d]\n", message, (int) getpid());
1498:
1499: free(message);
1500: free((*s_etat_processus).instruction_courante);
1501:
1502: if ((*s_etat_processus).var_volatile_processus_pere == 0)
1503: {
1504: envoi_signal_processus((*s_etat_processus).pid_processus_pere,
1505: rpl_sigalrm);
1506: }
1507: else
1508: {
1509: (*s_etat_processus).var_volatile_alarme = -1;
1510: }
1511:
1512: return(d_erreur);
1513: }
1514:
1515: return(d_absence_erreur);
1516: }
1517:
1518: // vim: ts=4
CVSweb interface <joel.bertrand@systella.fr>