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