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