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